summaryrefslogtreecommitdiffstats
path: root/debian/ada
diff options
context:
space:
mode:
authorDaniel Baumann <daniel.baumann@progress-linux.org>2024-04-17 12:22:56 +0000
committerDaniel Baumann <daniel.baumann@progress-linux.org>2024-04-17 12:22:56 +0000
commit3f472a4e5ca21e3ddb13737473e636b2b11a408a (patch)
tree7db1ab317884b9f6e04b6e13737c1679879cb97a /debian/ada
parentAdding upstream version 13.2.0. (diff)
downloadgcc-13-3f472a4e5ca21e3ddb13737473e636b2b11a408a.tar.xz
gcc-13-3f472a4e5ca21e3ddb13737473e636b2b11a408a.zip
Adding debian version 13.2.0-10.debian/13.2.0-10debian
Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>
Diffstat (limited to 'debian/ada')
-rw-r--r--debian/ada/README.gnat40
-rw-r--r--debian/ada/confirm_debian_bugs.py901
-rw-r--r--debian/ada/gnatgcc19
-rwxr-xr-xdebian/ada/libgnat_alihash39
-rw-r--r--debian/ada/test_ada_source_date_epoch.sh97
5 files changed, 1096 insertions, 0 deletions
diff --git a/debian/ada/README.gnat b/debian/ada/README.gnat
new file mode 100644
index 0000000..43febc3
--- /dev/null
+++ b/debian/ada/README.gnat
@@ -0,0 +1,40 @@
+If you want to develop Ada programs and libraries on Debian, please
+read the Debian Policy for Ada:
+
+http://people.debian.org/~lbrenta/debian-ada-policy.html
+
+The default Ada compiler is and always will be the package `gnat'.
+Debian contains many programs and libraries compiled with it, which
+are all ABI-compatible.
+
+Starting with gnat-4.2, Debian provides both zero-cost and
+setjump/longjump versions of the run-time library. The zero-cost
+exception handling mechanism is the default as it provides the best
+performance. The setjump/longjump exception handling mechanism is new
+and only provided as a static library. It is necessary to use this
+exception handling mechanism in distributed (annex E) programs. If
+you wish to use the new sjlj library:
+
+1) call gnatmake with --RTS=sjlj
+2) call gnatbind with -static
+
+Do NOT link your programs with libgnat-4.2.so, because it uses the ZCX
+mechanism.
+
+
+This package also includes small tools covering specific needs.
+
+* When linking objects compiled from both Ada and C sources, you need
+ to use compatible versions of the Ada and C compilers. The
+ required major version is the output of
+ # gnatmake --version | sed 's/.* \([0-9]\+\).*/\1/;q')
+ Then compile C sources with gcc-MAJOR instead of gcc.
+ For GPR projects, this should be sufficient:
+ # gprconfig --batch --config=Ada --config=C,,,,MAJOR
+
+ The same advice applies to C++, Fortran and assembly.
+ The former /usr/bin/gnatgcc is now deprecated.
+
+* When packaging Ada sources for Debian, you may want to read the
+ /usr/share/ada/debian_packaging.mk Makefile snippet from the gnat
+ package.
diff --git a/debian/ada/confirm_debian_bugs.py b/debian/ada/confirm_debian_bugs.py
new file mode 100644
index 0000000..2b8c6e1
--- /dev/null
+++ b/debian/ada/confirm_debian_bugs.py
@@ -0,0 +1,901 @@
+#!/usr/bin/python3
+
+# Helper when migrating bugs from a gnat version to another.
+
+# Attempt to reproduce each known GNAT bug with version BV.
+# Reports results as control@bugs.debian.org commands.
+# Only remove temporary subdirectories when the bug is reproduced.
+
+# python3 confirm_debian_bugs.py same BV -> found | fixed
+# python3 confirm_debian_bugs.py new BV -> reassign | retitle
+
+from __future__ import print_function
+import os.path
+import re
+import shutil
+import subprocess
+import sys
+import tempfile
+
+os.environ ['LC_ALL'] = 'C'
+
+assert len (sys.argv) == 3
+assert sys.argv [1] in ("same", "new")
+same_gcc_base_version = sys.argv [1] == "same"
+new_version = sys.argv [2]
+
+for line in subprocess.check_output (("dpkg", "--status", "gnat-" + new_version)).decode ().split ("\n"):
+ if line.startswith ("Version: "):
+ deb_version = line [len ("Version: "):]
+ break
+# Will cause an error later if deb_version is not defined.
+
+# Each bug has its own subdirectory in WORKSPACE.
+# Every bug subdir is removed if the bug is confirmed,
+# and WORKSPACE is removed if empty.
+workspace = tempfile.mkdtemp (suffix = "-gnat-" + deb_version + "-bugs")
+
+def attempt_to_reproduce (bug, make, sources):
+ tmp_dir = os.path.join (workspace, "bug{}".format (bug))
+ os.mkdir (tmp_dir)
+
+ for (name, contents) in sources:
+ with open (os.path.join (tmp_dir, name), "w") as f:
+ f.write (contents)
+
+ path = os.path.join (tmp_dir, "stderr.log")
+ with open (path, "w") as e:
+ status = subprocess.call (make, stderr=e, cwd=tmp_dir)
+ with open (path, "r") as e:
+ stderr = e.read ()
+ return tmp_dir, status, stderr
+
+def reassign_and_remove_dir (bug, tmp_dir):
+ if same_gcc_base_version:
+ print ("found {} {}".format (bug, deb_version))
+ else:
+ print ("reassign {} {} {}".format (bug, "gnat-" + new_version, deb_version))
+ shutil.rmtree (tmp_dir)
+
+def report (bug, message, output):
+ print ("# {}: {}.".format (bug, message))
+ for line in output.split ("\n"):
+ print ("# " + line)
+
+def report_and_retitle (bug, message, output):
+ report (bug, message, output)
+ if same_gcc_base_version:
+ print ("fixed {} {}".format (bug, deb_version))
+ else:
+ print ("retitle {} [Fixed in {}] <current title>".format (bug, new_version))
+
+def check_compiles_but_should_not (bug, make, sources):
+ tmp_dir, status, stderr = attempt_to_reproduce (bug, make, sources)
+ if status == 0:
+ reassign_and_remove_dir (bug, tmp_dir)
+ else:
+ report_and_retitle (bug, "now fails to compile (bug is fixed?)", stderr)
+
+def check_reports_an_error_but_should_not (bug, make, sources, regex):
+ tmp_dir, status, stderr = attempt_to_reproduce (bug, make, sources)
+ if status == 0:
+ report_and_retitle (bug, "now compiles (bug is fixed?)", stderr)
+ elif re.search (regex, stderr):
+ reassign_and_remove_dir (bug, tmp_dir)
+ else:
+ report (bug, "still fails to compile, but with a new stderr", stderr)
+
+def check_reports_error_but_forgets_one (bug, make, sources, regex):
+ tmp_dir, status, stderr = attempt_to_reproduce (bug, make, sources)
+ if status == 0:
+ report (bug, "now compiles (?)", stderr);
+ elif re.search (regex, stderr):
+ report_and_retitle (bug, "now reports the error (bug is fixed ?)", stderr)
+ else:
+ reassign_and_remove_dir (bug, tmp_dir)
+
+def check_produces_a_faulty_executable (bug, make, sources, regex, trigger):
+ tmp_dir, status, stderr = attempt_to_reproduce (bug, make, sources)
+ if status != 0:
+ report (bug, "cannot compile the trigger anymore", stderr)
+ else:
+ output = subprocess.check_output ((os.path.join (tmp_dir, trigger),), cwd=tmp_dir).decode ()
+ if re.search (regex, output):
+ reassign_and_remove_dir (bug, tmp_dir)
+ else:
+ report_and_retitle (bug, "output of the trigger changed (bug fixed?)", output)
+
+######################################################################
+
+check_reports_an_error_but_should_not (
+ bug = 244936,
+ make = ("gnatmake", "p"),
+ regex = 'p\.ads:3:25: error: "foo" is hidden within declaration of instance',
+ sources = (
+ ("foo.ads", """generic
+procedure foo;
+"""),
+ ("foo.adb", """procedure foo is
+begin
+ null;
+end foo;
+"""), ("p.ads", """with foo;
+package p is
+ procedure FOO is new foo; -- OK
+end p;
+""")))
+
+check_compiles_but_should_not (
+ bug = 244970,
+ make = ("gnatmake", "pak5"),
+ sources = (
+ ("pak1.ads", """generic
+package pak1 is
+end pak1;
+"""),
+ ("pak1-pak2.ads", """generic
+package pak1.pak2 is
+end pak1.pak2;
+"""),
+ ("pak5.ads", """with pak1.pak2;
+generic
+ with package new_pak2 is new pak1.pak2; -- ERROR: illegal use of pak1
+package pak5 is
+end pak5;
+""")))
+
+check_reports_an_error_but_should_not (
+ bug = 246187,
+ make = ("gnatmake", "test_43"),
+ regex = "Error detected at test_43.ads:11:4",
+ sources = (
+ ("test_43.ads", """package Test_43 is
+ type T1 is private;
+
+private
+
+ type T2 is record
+ a: T1;
+ end record;
+ type T2_Ptr is access T2;
+
+ type T1 is record
+ n: T2_Ptr := new T2;
+ end record;
+
+end Test_43;
+"""),))
+
+check_compiles_but_should_not (
+ bug = 247013,
+ make = ("gnatmake", "test_53"),
+ sources = (
+ ("test_53.ads", """generic
+ type T1 is private;
+package Test_53 is
+ type T2 (x: integer) is new T1; -- ERROR: x not used
+end Test_53;
+"""),))
+
+check_compiles_but_should_not (
+ bug = 247017,
+ make = ("gnatmake", "test_59"),
+ sources = (
+ ("test_59.adb", """procedure Test_59 is
+
+ generic
+ type T1 (<>) is private;
+ procedure p1(x: out T1);
+
+ procedure p1 (x: out T1) is
+ b: boolean := x'constrained; --ERROR: not a discriminated type
+ begin
+ null;
+ end p1;
+
+begin
+ null;
+end Test_59;
+"""),))
+
+check_compiles_but_should_not (
+ bug = 247018,
+ make = ("gnatmake", "test_60"),
+ sources = (
+ ("pak1.ads", """package pak1 is
+ generic
+ package pak2 is
+ end pak2;
+end pak1;
+"""),
+ ("test_60.ads", """with pak1;
+package Test_60 is
+ package PAK1 is new pak1.pak2; --ERROR: illegal reference to pak1
+end Test_60;
+""")))
+
+check_compiles_but_should_not (
+ bug = 247019,
+ make = ("gnatmake", "test_61"),
+ sources = (
+ ("test_61.adb", """procedure Test_61 is
+ procedure p1;
+
+ generic
+ package pak1 is
+ procedure p2 renames p1;
+ end pak1;
+
+ package new_pak1 is new pak1;
+ procedure p1 renames new_pak1.p2; --ERROR: circular renames
+begin
+ p1;
+end Test_61;
+"""),))
+
+check_produces_a_faulty_executable (
+ bug = 247569,
+ make = ("gnatmake", "test_75"),
+ trigger = "test_75",
+ regex = "failed: wrong p1 called",
+ sources = (
+ ("test_75.adb", """with text_io;
+procedure Test_75 is
+ generic
+ package pak1 is
+ type T1 is null record;
+ end pak1;
+
+ generic
+ with package A is new pak1(<>);
+ with package B is new pak1(<>);
+ package pak2 is
+ procedure p1(x: B.T1);
+ procedure p1(x: A.T1);
+ end pak2;
+
+ package body pak2 is
+
+ procedure p1(x: B.T1) is
+ begin
+ text_io.put_line("failed: wrong p1 called");
+ end p1;
+
+ procedure p1(x: A.T1) is
+ begin
+ text_io.put_line("passed");
+ end p1;
+
+ x: A.T1;
+ begin
+ p1(x);
+ end pak2;
+
+ package new_pak1 is new pak1;
+ package new_pak2 is new pak2(new_pak1, new_pak1); -- (1)
+
+begin
+ null;
+end Test_75;
+"""),))
+
+check_compiles_but_should_not (
+ bug = 247570,
+ make = ("gnatmake", "test_76"),
+ sources = (
+ ("test_76.adb", """procedure Test_76 is
+
+ generic
+ procedure p1;
+
+ pragma Convention (Ada, p1);
+
+ procedure p1 is
+ begin
+ null;
+ end p1;
+
+ procedure new_p1 is new p1;
+ pragma Convention (Ada, new_p1); --ERROR: new_p1 already frozen
+
+begin
+ null;
+end Test_76;
+"""),))
+
+check_produces_a_faulty_executable (
+ bug = 247571,
+ make = ("gnatmake", "test_77"),
+ trigger = "test_77",
+ regex = "failed: wrong p1 called",
+ sources = (
+ ("pak.ads", """package pak is
+ procedure p1;
+ procedure p1(x: integer);
+ pragma export(ada, p1);
+end pak;
+"""),
+ ("pak.adb", """with text_io; use text_io;
+package body pak is
+ procedure p1 is
+ begin
+ put_line("passed");
+ end;
+
+ procedure p1(x: integer) is
+ begin
+ put_line("failed: wrong p1 called");
+ end;
+end pak;
+"""),
+ ("test_77.adb", """with pak;
+procedure Test_77 is
+ procedure p1;
+ pragma import(ada, p1);
+begin
+ p1;
+end Test_77;
+""")))
+
+check_compiles_but_should_not (
+ bug = 248166,
+ make = ("gnatmake", "test_82"),
+ sources = (
+ ("test_82.adb", """procedure Test_82 is
+ package pak1 is
+ type T1 is tagged null record;
+ end pak1;
+
+ package body pak1 is
+ -- type T1 is tagged null record; -- line 7
+
+ function "=" (x, y : T1'class) return boolean is -- line 9
+ begin
+ return true;
+ end "=";
+
+ procedure proc (x, y : T1'class) is
+ b : boolean;
+ begin
+ b := x = y; --ERROR: ambiguous "="
+ end proc;
+
+ end pak1;
+
+begin
+ null;
+end Test_82;
+"""),))
+
+check_compiles_but_should_not (
+ bug = 248168,
+ make = ("gnatmake", "test_84"),
+ sources = (
+ ("test_84.adb", """procedure Test_84 is
+ package pak1 is
+ type T1 is abstract tagged null record;
+ procedure p1(x: in out T1) is abstract;
+ end pak1;
+
+ type T2 is new pak1.T1 with null record;
+
+ protected type T3 is
+ end T3;
+
+ protected body T3 is
+ end T3;
+
+ procedure p1(x: in out T2) is --ERROR: declared after body of T3
+ begin
+ null;
+ end p1;
+
+begin
+ null;
+end Test_84;
+"""),))
+
+check_compiles_but_should_not (
+ bug = 248678,
+ make = ("gnatmake", "test_80"),
+ sources = (
+ ("test_80.ads", """package Test_80 is
+ generic
+ type T1(<>) is private;
+ with function "=" (Left, Right : T1) return Boolean is <>;
+ package pak1 is
+ end pak1;
+
+ package pak2 is
+ type T2 is abstract tagged null record;
+ package new_pak1 is new pak1 (T2'Class); --ERROR: no matching "="
+ end pak2;
+end Test_80;
+"""),))
+
+check_compiles_but_should_not (
+ bug = 248681,
+ make = ("gnatmake", "test_91"),
+ sources = (
+ ("test_91.adb", """-- RM 8.5.4(5)
+-- ...the convention of the renamed subprogram shall not be
+-- Intrinsic.
+with unchecked_deallocation;
+procedure Test_91 is
+ generic -- when non generic, we get the expected error
+ package pak1 is
+ type int_ptr is access integer;
+ procedure free(x: in out int_ptr);
+ end pak1;
+
+ package body pak1 is
+ procedure deallocate is new
+ unchecked_deallocation(integer, int_ptr);
+ procedure free(x: in out int_ptr) renames
+ deallocate; --ERROR: renaming as body can't rename intrinsic
+ end pak1;
+begin
+ null;
+end Test_91;
+"""),))
+
+check_compiles_but_should_not (
+ bug = 248682,
+ make = ("gnatmake", "main"),
+ sources = (
+ ("main.adb", """-- RM 6.3.1(9)
+-- The default calling convention is Intrinsic for ... an attribute
+-- that is a subprogram;
+
+-- RM 8.5.4(5)
+-- ...the convention of the renamed subprogram shall not be
+-- Intrinsic.
+procedure main is
+ package pak1 is
+ function f1(x: integer'base) return integer'base;
+ end pak1;
+
+ package body pak1 is
+ function f1(x: integer'base) return integer'base renames
+ integer'succ; --ERROR: renaming as body can't rename intrinsic
+ end pak1;
+begin
+ null;
+end;
+"""),))
+
+check_reports_an_error_but_should_not (
+ bug = 253737,
+ make = ("gnatmake", "test_4"),
+ regex = 'test_4\.ads:3:01: error: "pak2" not declared in "pak1"',
+ sources = (
+ ("parent.ads", """generic
+package parent is
+end parent;
+"""),
+ ("parent-pak2.ads", """generic
+package parent.pak2 is
+end parent.pak2;
+"""),
+ ("parent-pak2-pak3.ads", """generic
+package parent.pak2.pak3 is
+end parent.pak2.pak3;
+"""),
+ ("parent-pak2-pak4.ads", """with parent.pak2.pak3;
+generic
+package parent.pak2.pak4 is
+ package pak3 is new parent.pak2.pak3;
+end parent.pak2.pak4;
+"""),
+ ("pak1.ads", """with parent;
+package pak1 is new parent;
+"""),
+ ("pak6.ads", """with parent.pak2;
+with pak1;
+package pak6 is new pak1.pak2;
+"""),
+ ("test_4.ads", """with parent.pak2.pak4;
+with pak6;
+package Test_4 is new pak6.pak4;
+""")))
+
+check_compiles_but_should_not (
+ bug = 269948,
+ make = ("gnatmake", "test_119"),
+ sources = (
+ ("test_119.ads", """-- RM 3.9.3/11 A generic actual subprogram shall not be an abstract
+-- subprogram. works OK if unrelated line (A) is commented out.
+package Test_119 is
+ generic
+ with function "=" (X, Y : integer) return Boolean is <>; -- Removing this allows GCC to detect the problem.
+ package pak1 is
+ function "=" (X, Y: float) return Boolean is abstract;
+ generic
+ with function Equal (X, Y : float) return Boolean is "="; --ERROR:
+ package pak2 is
+ end pak2;
+ end pak1;
+
+ package new_pak1 is new pak1;
+ package new_pak2 is new new_pak1.pak2;
+end Test_119;
+"""),))
+
+check_compiles_but_should_not (
+ bug = 269951,
+ make = ("gnatmake", "test_118"),
+ sources = (
+ ("pak1.ads", """generic
+package pak1 is
+end pak1;
+"""),
+ ("pak1-foo.ads", """generic
+package pak1.foo is
+end pak1.foo;
+"""),
+ ("test_118.ads", """with pak1.foo;
+package Test_118 is
+ package pak3 is
+ foo: integer;
+ end pak3;
+ use pak3;
+
+ package new_pak1 is new pak1;
+ use new_pak1;
+
+ x: integer := foo; -- ERROR: foo hidden by use clauses
+end Test_118;
+"""),))
+
+# As long as 24:14 is detected, it inhibits detection of 25:21.
+check_reports_error_but_forgets_one (
+ bug = 276224,
+ make = ("gnatmake", "test_121"),
+ regex = "test_121\.adb:25:21: dynamically tagged expression not allowed",
+ sources = (
+ ("test_121.adb", """-- If the expected type for an expression or name is some specific
+-- tagged type, then the expression or name shall not be dynamically
+-- tagged unless it is a controlling operand in a call on a
+-- dispatching operation.
+procedure Test_121 is
+ package pak1 is
+ type T1 is tagged null record;
+ function f1 (x1: T1) return T1;
+ end pak1;
+
+ package body pak1 is
+ function f1 (x1: T1) return T1 is
+ begin
+ return x1;
+ end;
+ end pak1;
+ use pak1;
+
+ type T2 is record
+ a1: T1;
+ end record;
+
+ z0: T1'class := T1'(null record);
+ z1: T1 := f1(z0); -- ERROR: gnat correctly rejects
+ z2: T2 := (a1 => f1(z0)); -- ERROR: gnat mistakenly allows
+begin
+ null;
+end Test_121;
+"""),))
+
+check_reports_an_error_but_should_not (
+ bug = 276227,
+ make = ("gnatmake", "test_124"),
+ regex = 'test_124\.ads:6:35: error: size for "T_arr_constrained" too small, minimum allowed is 256',
+ sources = (
+ ("test_124.ads", """package Test_124 is
+ type T is range 1 .. 32;
+ type T_arr_unconstrained is array (T range <>) of boolean;
+ type T_arr_constrained is new T_arr_unconstrained (T);
+ pragma pack (T_arr_unconstrained);
+ for T_arr_constrained'size use 32;
+end Test_124;
+"""),))
+
+check_reports_an_error_but_should_not (
+ bug = 278687,
+ make = ("gnatmake", "test_127"),
+ regex = 'test_127\.adb:10:21: error: expected type "T2" defined at line 4',
+ sources = (
+ ("test_127.ads", """-- The second parameter of T2'Class'Read is of type T2'Class,
+-- which should match an object of type T3, which is derived
+-- from T2.
+package test_127 is
+ pragma elaborate_body;
+end test_127;
+"""),
+ ("test_127.adb", """with ada.streams;
+package body test_127 is
+ type T1 is access all ada.streams.root_stream_type'class;
+ type T2 is tagged null record;
+ type T3 is new T2 with null record;
+
+ x: T1;
+ y: T3;
+begin
+ T2'class'read(x, y);
+end test_127;
+""")))
+
+check_compiles_but_should_not (
+ bug = 278831,
+ make = ("gnatmake", "test_128"),
+ sources = (
+ ("test_128.ads", """package Test_128 is
+ package inner is
+ private
+ type T1;
+ end inner;
+ type T1_ptr is access inner.T1; -- line 9 ERROR: gnat mistakenly accepts
+end Test_128;
+"""),
+ ("test_128.adb", """package body test_128 is
+ package body inner is
+ type T1 is new Integer;
+ end inner;
+end Test_128;
+""")))
+
+# Note that we also check the absence of the next inhibited message.
+check_reports_an_error_but_should_not (
+ bug = 279893,
+ make = ("gnatmake", "test_129"),
+ regex = 'test_129\.ads:13:49: error: designated type of actual does not match that of formal "T2"',
+ sources = (
+ ("pak1.ads", """-- legal instantiation rejected; illegal instantiation accepted
+-- adapted from John Woodruff c.l.a. post
+
+generic
+ type T1 is private;
+package pak1 is
+ subtype T3 is T1;
+end pak1;
+"""),
+ ("pak2.ads", """with pak1;
+generic
+ type T2 is private;
+package pak2 is
+ package the_pak1 is new pak1 (T1 => T2);
+end pak2;
+"""),
+ ("pak2-pak3.ads", """generic
+ type T2 is access the_pak1.T3;
+package pak2.pak3 is
+end pak2.pak3;
+"""),
+ ("test_129.ads", """with pak1;
+with pak2.pak3;
+package Test_129 is
+
+ type T4 is null record;
+ type T5 is null record;
+ subtype T3 is T5; -- line 9: triggers the bug at line 16
+
+ type T4_ptr is access T4;
+ type T5_ptr is access T5;
+
+ package new_pak2 is new pak2 (T2 => T4);
+ package new_pak3a is new new_pak2.pak3(T2 => T4_ptr); -- line 15: Legal
+ package new_pak3b is new new_pak2.pak3(T2 => T5_ptr); -- line 16: Illegal
+end Test_129;
+""")))
+
+print ("# Please ignore the gnatlink message.")
+check_reports_an_error_but_should_not (
+ bug = 280939,
+ make = ("gnatmake", "test_130"),
+ regex = "test_130\.adb:.*: undefined reference to \`p2\'",
+ sources = (
+ ("pak1.ads", """-- RM 10.1.5(4) "the pragma shall have an argument that is a name
+-- denoting that declaration."
+-- RM 8.1(16) "The children of a parent library unit are inside the
+-- parent's declarative region."
+
+package pak1 is
+ pragma Pure;
+end pak1;
+"""),
+ ("pak1-p2.ads", """procedure pak1.p2;
+pragma Pure (p2); -- ERROR: need expanded name
+pragma Import (ada, p2); -- ERROR: need expanded name
+pragma Inline (p2); -- ERROR: need expanded name
+"""),
+ ("test_130.adb", """with Pak1.P2;
+procedure Test_130 is
+begin
+ Pak1.P2;
+end Test_130;
+""")))
+
+check_compiles_but_should_not (
+ bug = 283833,
+ make = ("gnatmake", "test_132"),
+ sources = (
+ ("pak1.ads", """-- RM 8.5.4(5) the convention of the renamed subprogram shall not
+-- be Intrinsic, if the renaming-as-body completes that declaration
+-- after the subprogram it declares is frozen.
+
+-- RM 13.14(3) the end of the declaration of a library package
+-- causes freezing of each entity declared within it.
+
+-- RM 6.3.1(7) the default calling convention is Intrinsic for
+-- any other implicitly declared subprogram unless it is a
+-- dispatching operation of a tagged type.
+
+package pak1 is
+ type T1 is null record;
+ procedure p1 (x1: T1);
+ type T2 is new T1;
+end pak1;
+"""),
+ ("pak1.adb", """package body Pak1 is
+ procedure P1 (X1 : T1) is begin null; end P1;
+end Pak1;
+"""),
+ ("test_132.ads", """with pak1;
+package Test_132 is
+ procedure p2 (x2: pak1.T2);
+end Test_132;
+"""),
+ ("test_132.adb", """package body Test_132 is
+ procedure p2 (x2: pak1.T2) renames pak1.p1; --ERROR: can't rename intrinsic
+end Test_132;
+""")))
+
+check_compiles_but_should_not (
+ bug = 283835,
+ make = ("gnatmake", "test_133"),
+ sources = (
+ ("test_133.ads", """package Test_133 is
+ package pak1 is
+ type T1 is null record;
+ end pak1;
+
+ package pak2 is
+ subtype boolean is standard.boolean;
+ function "=" (x, y: pak1.T1) return boolean;
+ end pak2;
+
+ use pak1, pak2;
+
+ x1: pak1.T1;
+ b1: boolean := x1 /= x1; -- ERROR: ambigous (gnat misses)
+ -- b2: boolean := x1 = x1; -- ERROR: ambigous
+end Test_133;
+"""),
+ ("test_133.adb", """package body test_133 is
+ package body pak2 is
+ function "=" (x, y: pak1.T1) return boolean is
+ begin
+ return true;
+ end "=";
+ end pak2;
+end test_133;
+""")))
+
+check_compiles_but_should_not (
+ bug = 416979,
+ make = ("gnatmake", "pak1"),
+ sources = (
+ ("pak1.ads", """package pak1 is
+ -- RM 7.3(13), 4.9.1(1)
+ -- check that discriminants statically match
+ type T1(x1: integer) is tagged null record;
+ x2: integer := 2;
+ x3: constant integer := x2;
+ type T2 is new T1 (x2) with private;
+ type T3 is new T1 (x3) with private;
+private
+ type T2 is new T1 (x2) with null record; --ERROR: nonstatic discriminant
+ type T3 is new T1 (x3) with null record; --ERROR: nonstatic discriminant
+end pak1;
+"""),))
+
+check_reports_an_error_but_should_not (
+ bug = 660698,
+ make = ("gnatmake", "proc.adb"),
+ regex = 'proc\.adb:17:28: error: there is no applicable operator "And" for type "Standard\.Integer"',
+ sources = (
+ ("proc.adb", """procedure Proc is
+ package P1 is
+ type T is new Integer;
+ function "and" (L, R : in Integer) return T;
+ end P1;
+ package body P1 is
+ function "and" (L, R : in Integer) return T is
+ pragma Unreferenced (L, R);
+ begin
+ return 0;
+ end "and";
+ end P1;
+ use type P1.T;
+ package P2 is
+ use P1;
+ end P2;
+ G : P1.T := Integer'(1) and Integer'(2);
+begin
+ null;
+end Proc;
+"""), ))
+
+# Even if an error is reported, the problem with the atomic variable
+# should be checked.
+check_reports_an_error_but_should_not (
+ bug = 643663,
+ make = ("gnatmake", "test"),
+ regex = 'test\.adb:4:25: error: no value supplied for component "Reserved"',
+ sources = (
+ ("pkg.ads", """package Pkg is
+ type Byte is mod 2**8;
+ type Reserved_24 is mod 2**24;
+
+ type Data_Record is
+ record
+ Data : Byte;
+ Reserved : Reserved_24;
+ end record;
+
+ for Data_Record use
+ record
+ Data at 0 range 0 .. 7;
+ Reserved at 0 range 8 .. 31;
+ end record;
+
+ for Data_Record'Size use 32;
+ for Data_Record'Alignment use 4;
+
+ Data_Register : Data_Record;
+ pragma Atomic (Data_Register);
+end Pkg;
+"""), ("test.adb", """with Pkg;
+procedure Test is
+begin
+ Pkg.Data_Register := (
+ Data => 255,
+ others => <> -- expected error: no value supplied for component "Reserved"
+ );
+end Test;
+""")))
+
+check_produces_a_faulty_executable (
+ bug = 864969,
+ make = ("gnatmake", "main"),
+ trigger = "main",
+ regex = "ZZund",
+ sources = (
+ ("main.adb", """with Ada.Locales, Ada.Text_IO;
+procedure Main is
+begin
+ Ada.Text_IO.Put_Line (String (Ada.Locales.Country)
+ & String (Ada.Locales.Language));
+end Main;
+"""),))
+
+check_produces_a_faulty_executable (
+ bug = 894225,
+ make = ("gnatmake", "main"),
+ trigger = "main",
+ sources = (
+ ("main.adb",
+ """with Ada.Directories, Ada.Text_IO;
+procedure Main is
+begin
+ Ada.Text_IO.Put_Line (Ada.Directories.Containing_Directory ("/a/b/"));
+ Ada.Text_IO.Put_Line (Ada.Directories.Containing_Directory ("a/b/"));
+ Ada.Text_IO.Put_Line (Ada.Directories.Containing_Directory ("b/"));
+end Main;
+"""),
+ ),
+ regex = """^/a/b
+a/b
+b$""")
+
+try:
+ os.rmdir (workspace)
+except:
+ print ("Some unconfirmed, not removing directory {}.".format (workspace))
diff --git a/debian/ada/gnatgcc b/debian/ada/gnatgcc
new file mode 100644
index 0000000..9aae5dc
--- /dev/null
+++ b/debian/ada/gnatgcc
@@ -0,0 +1,19 @@
+#!/bin/sh
+# Installed as /usr/bin/$DEB_HOST_GNU_TYPE-gnatgcc
+# and symlinked as /usr/bin/gnatgcc.
+set -Cefu
+
+cat <<EOF
+
+Warning: gnatgcc is deprecated.
+Please call gcc-MAJOR directly.
+For GPR projects, this should be sufficient:
+# gprconfig --batch --config=Ada --config=C,,,,MAJOR
+MAJOR is the output of
+# gnatmake --version | sed 's/.* \([0-9]\+\).*/\1/;q'
+
+EOF
+
+host=$(basename "$0" | sed 's/gnatgcc$//')
+major=$(${host}gnatmake --version | sed 's/.* \([0-9]\+\).*/\1/;q')
+exec ${host}gcc-$major "$@"
diff --git a/debian/ada/libgnat_alihash b/debian/ada/libgnat_alihash
new file mode 100755
index 0000000..26b223e
--- /dev/null
+++ b/debian/ada/libgnat_alihash
@@ -0,0 +1,39 @@
+#!/usr/bin/perl
+
+# Helper for debian/rules2.
+
+# Exit silently during builds without Ada.
+
+# If .ali (Ada Library Information) files are found in gnat RTS directory,
+# output a dpkg-gencontrol command line argument setting the
+# libgnat:Provides substitution variable
+# to the XOR of the checksums in all such files,
+# as 8 lowercase hexadecimal digits.
+
+# See https://people.debian.org/~lbrenta/debian-ada-policy.html.
+
+# Should be in sync with dh_ada_library in the dh-ada-library package.
+
+# perl -c $script
+# perltidy $script -st | diff -u $script -
+# perlcritic -1 --verbose=11 --exclude=Modules::RequireVersionVar $script
+
+use autodie;
+use re '/amsx';
+use strict;
+use warnings;
+
+my @ali_files = glob 'build/gcc/ada/rts/*.ali';
+if (@ali_files) {
+ my $result = 0;
+ for my $path (@ali_files) {
+ open my $fh, q{<}, $path;
+ while (<$fh>) {
+ if (m/ ^ D [ ] [^\t]+ \t+ \d{14} [ ] ( [[:xdigit:]]{8} ) /) {
+ $result ^= hex $1;
+ }
+ }
+ close $fh;
+ }
+ printf '-Vlibgnat:alihash=%08x', $result;
+}
diff --git a/debian/ada/test_ada_source_date_epoch.sh b/debian/ada/test_ada_source_date_epoch.sh
new file mode 100644
index 0000000..5154341
--- /dev/null
+++ b/debian/ada/test_ada_source_date_epoch.sh
@@ -0,0 +1,97 @@
+#!/bin/sh
+# Basic checks for debian/patches/ada-lib-info-source-date-epoch.diff.
+
+# Copyright (C) 2020 Nicolas Boulenguez <nicolas@debian.org>
+
+# Usage:
+# build GCC
+# sh debian/ada/test_ada_source_date_epoch.sh
+# rm -fr build/test_ada_source_data_epoch
+
+set -C -e -u -x
+
+# Inside the GCC tree:
+mkdir build/test_ada_source_data_epoch
+cd build/test_ada_source_data_epoch
+export LD_LIBRARY_PATH=../gcc/ada/rts:`echo ../*/libgnat_util/.libs`
+gnatmake="../gcc/gnatmake --RTS=`echo ../*/libada` --GCC=../gcc/xgcc -c -v"
+# For local tests:
+# gnatmake="gnatmake -c -v"
+
+cat > lib.ads <<EOF
+package Lib is
+ Message : constant String := "Hello";
+end Lib;
+EOF
+cat > main.adb <<EOF
+with Ada.Text_IO;
+with Lib;
+procedure Main is
+begin
+ Ada.Text_IO.Put_Line (Lib.Message);
+end Main;
+EOF
+
+touch lib.ads -d @20
+
+echo ______________________________________________________________________
+echo 'No ALI nor object'
+
+rm -f lib.ali lib.o
+$gnatmake main.adb
+grep '^D lib\.ads\s\+19700101000020' lib.ali
+grep '^D lib\.ads\s\+19700101000020' main.ali
+
+rm -f lib.ali lib.o
+SOURCE_DATE_EPOCH=10 $gnatmake main.adb
+grep '^D lib\.ads\s\+19700101000010' lib.ali
+grep '^D lib\.ads\s\+19700101000010' main.ali # gnat-9.3.0-8 says 20
+
+rm -f lib.ali lib.o
+SOURCE_DATE_EPOCH=30 $gnatmake main.adb
+grep '^D lib\.ads\s\+19700101000020' lib.ali
+grep '^D lib\.ads\s\+19700101000020' main.ali
+
+echo ______________________________________________________________________
+echo 'ALI older than object'
+
+touch lib.ali -d @40
+touch lib.o -d @50
+$gnatmake main.adb
+grep '^D lib\.ads\s\+19700101000020' lib.ali
+grep '^D lib\.ads\s\+19700101000020' main.ali
+
+touch lib.ali -d @40
+touch lib.o -d @50
+SOURCE_DATE_EPOCH=10 $gnatmake main.adb
+grep '^D lib\.ads\s\+19700101000010' lib.ali # gnat-9.3.0-8 says 20
+grep '^D lib\.ads\s\+19700101000010' main.ali # gnat-9.3.0-8 says 20
+
+touch lib.ali -d @40
+touch lib.o -d @50
+SOURCE_DATE_EPOCH=30 $gnatmake main.adb
+grep '^D lib\.ads\s\+19700101000020' lib.ali
+grep '^D lib\.ads\s\+19700101000020' main.ali
+
+echo ______________________________________________________________________
+echo 'Object older than ALI'
+
+touch lib.o -d @40
+touch lib.ali -d @50
+$gnatmake main.adb
+grep '^D lib\.ads\s\+19700101000020' lib.ali
+grep '^D lib\.ads\s\+19700101000020' main.ali
+
+touch lib.o -d @40
+touch lib.ali -d @50
+SOURCE_DATE_EPOCH=10 $gnatmake main.adb
+grep '^D lib\.ads\s\+19700101000010' lib.ali
+grep '^D lib\.ads\s\+19700101000010' main.ali # gnat-9.3.0-8 says 20
+
+touch lib.o -d @40
+touch lib.ali -d @50
+SOURCE_DATE_EPOCH=30 $gnatmake main.adb
+grep '^D lib\.ads\s\+19700101000020' lib.ali
+grep '^D lib\.ads\s\+19700101000020' main.ali
+
+echo "All tests passed"