diff options
Diffstat (limited to 'gcc-4.9/gcc/testsuite/ada/acats/support')
65 files changed, 12906 insertions, 0 deletions
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; |