Task crashes before starting if class-wide object, not otherwise

evanescente-ondine · April 26, 2026, 2:57pm

Hi,

I have been tasked to simulate a digital circuit with gates as tasks and wires as channels (rendezvous). I tried to make it as general as possible, with an arbitrary number of inputs and outputs. This works (as far the baby test is concerned):

pragma Ada_2022;
with Ada.Text_IO; use Ada.Text_IO;
procedure Main2 is
	package Circuits is
		type BoolArray is array (Positive  range <>) of Boolean with Pack;
		function FnNot (Arr: BoolArray) return Boolean is (not Arr(1));
		function FnOr  (Arr: BoolArray) return Boolean is (Arr(1) or Arr(2));
		function FnXOr (Arr: BoolArray) return Boolean is (Arr(1) xor Arr(2));
		function FnAnd (Arr: BoolArray) return Boolean is (Arr(1) and Arr(2));
		function FnNor (Arr: BoolArray) return Boolean is (not Arr(1) and not Arr(2));
		type GateType is task interface;
		procedure Enter (T: GateType; V: Boolean) is abstract;
		type Circuit is array (Positive range <>) of access constant GateType'Class;
		task type Gates
			(Nentries: Positive;
			Func: access function (A: BoolArray) return Boolean;
			OutputCircuit: access constant Circuit; Size: Positive) is new GateType with
			entry Enter (V: Boolean);
		end Gates;
		task type EndGate (Size: Positive) is new GateType with
			entry Enter (V: Boolean);
			entry GiveResult (R: out BoolArray);
		end EndGate;
		function MakeGate
			(Nentries: Positive;
			Func: access function (A: BoolArray) return Boolean;
			OutputCircuit: access constant Circuit; Size: Positive) return Gates'Class;
		function MakeEndgate (Size: Positive) return EndGate'Class;
	end Circuits;
	package body Circuits is
		task body Gates is
			InputArray: BoolArray (1..Nentries);
			Index: Natural range 0..Nentries := 1;
		begin
			for S in 1..Size loop
				for I in InputArray'Range loop
					accept Enter (V: Boolean) do
						InputArray (Index) := V;
					end Enter;
				end loop;
				Index := 1;
				for A of OutputCircuit.all loop 
					A.Enter(Func(InputArray));
				end loop;
			end loop;
		end Gates;
		task body EndGate is
			Result: BoolArray (1..Size);
			IndexR: Natural range 0..Size := 0;
		begin
			for S in 1..Size loop
				accept Enter (V: Boolean) do
					IndexR := @ + 1;
					Result (IndexR) := V;
				end Enter;
			end loop;
			accept GiveResult (R: out BoolArray) do
				R := Result;
			end GiveResult;
		end EndGate;
		function MakeGate
			(Nentries: Positive;
			Func: access function (A: BoolArray) return Boolean;
			OutputCircuit: access constant Circuit;
			Size: Positive) return Gates'Class is
		begin
			return G: Gates (Nentries, Func,OutputCircuit,Size);
		end MakeGate;
		function MakeEndGate (Size: Positive) return EndGate'Class is
		begin
			return G: EndGate (Size);
		end MakeEndGate;
	end Circuits;
	use Circuits;
	theEnd: aliased EndGate(1);
	OrGate: Gates (2, FnOr'Access, new Circuit'([theEnd'Access]), 1);
	theTable : BoolArray (1..1);
begin
	for I in 1..2 loop
		OrGate.Enter(Boolean'Val(I-1));
	end loop;
	EndGate(theEnd).GiveResult (theTable);
	Put_line(theTable'Image);
end Main2;

but if I make the tasks class-wide objects, they fail without starting (not reaching “begin”), and I get raised TASKING_ERROR : s-tasren.adb:377which I read usually denotes elaboration concerns, which I can’t understand since no task is created through an allocator.

pragma Ada_2022;
with Ada.Text_IO; use Ada.Text_IO;
procedure Main2 is
	package Circuits is
		type BoolArray is array (Positive  range <>) of Boolean with Pack;
		function FnNot (Arr: BoolArray) return Boolean is (not Arr(1));
		function FnOr  (Arr: BoolArray) return Boolean is (Arr(1) or Arr(2));
		function FnXOr (Arr: BoolArray) return Boolean is (Arr(1) xor Arr(2));
		function FnAnd (Arr: BoolArray) return Boolean is (Arr(1) and Arr(2));
		function FnNor (Arr: BoolArray) return Boolean is (not Arr(1) and not Arr(2));
		type GateType is task interface;
		procedure Enter (T: GateType; V: Boolean) is abstract;
		type Circuit is array (Positive range <>) of access constant GateType'Class;
		task type Gates
			(Nentries: Positive;
			Func: access function (A: BoolArray) return Boolean;
			OutputCircuit: access constant Circuit; Size: Positive) is new GateType with
			entry Enter (V: Boolean);
		end Gates;
		task type EndGate (Size: Positive) is new GateType with
			entry Enter (V: Boolean);
			entry GiveResult (R: out BoolArray);
		end EndGate;
		function MakeGate
			(Nentries: Positive;
			Func: access function (A: BoolArray) return Boolean;
			OutputCircuit: access constant Circuit; Size: Positive) return Gates'Class;
		function MakeEndgate (Size: Positive) return EndGate'Class;
	end Circuits;
	package body Circuits is
		task body Gates is
			InputArray: BoolArray (1..Nentries);
			Index: Natural range 0..Nentries := 1;
		begin
			for S in 1..Size loop
				for I in InputArray'Range loop
					accept Enter (V: Boolean) do
						InputArray (Index) := V;
					end Enter;
				end loop;
				Index := 1;
				for A of OutputCircuit.all loop 
					A.Enter(Func(InputArray));
				end loop;
			end loop;
		end Gates;
		task body EndGate is
			Result: BoolArray (1..Size);
			IndexR: Natural range 0..Size := 0;
		begin
			for S in 1..Size loop
				accept Enter (V: Boolean) do
					IndexR := @ + 1;
					Result (IndexR) := V;
				end Enter;
			end loop;
			accept GiveResult (R: out BoolArray) do
				R := Result;
			end GiveResult;
		end EndGate;
		function MakeGate
			(Nentries: Positive;
			Func: access function (A: BoolArray) return Boolean;
			OutputCircuit: access constant Circuit;
			Size: Positive) return Gates'Class is
		begin
			return G: Gates (Nentries, Func,OutputCircuit,Size);
		end MakeGate;
		function MakeEndGate (Size: Positive) return EndGate'Class is
		begin
			return G: EndGate (Size);
		end MakeEndGate;
	end Circuits;
	use Circuits;
	theEnd: aliased GateType'Class := MakeEndGate (1);
	OrGate: GateType'Class := MakeGate (2, FnOr'Access, new Circuit'([theEnd'Access]), 1);
	theTable : BoolArray (1..1);
begin
	for I in 1..2 loop
		OrGate.Enter(Boolean'Val(I-1));
	end loop;
	EndGate(theEnd).GiveResult (theTable);
	Put_line(theTable'Image);
end Main2;

dmitry-kazakov · April 26, 2026, 4:21pm

It looks like a compiler bug to me. You should be careful with “Pickwickian” functions, that is ones returning limited types. They should never exist, but were added to Ada as a workaround to avoid fixing lack of user-defined discriminants. They are very hard for the compiler because they do not return anything but initialize in-place. GNAT always had issues with them.

Another hack you would likely problems with is function expressions, especially when overriding primitive operations.

In general, try to avoid suspicious language constructs. It will save you frustration, debugging time and make design cleaner.

Solutions:

Remove MakeEndGate, declare the task explicitly:

theEnd: EndGate (2, FnOr'Access, 2);

Make MakeEndGate return EndGate (you need to move it out the package because of, well another language hack - task “interfaces” which will confuse the compiler if the type is not yet frozen).

Note also that EndGate’Class makes no sense. The whole “class” contains single type EndGate. You can derive a concrete type from a task interface only once. If you need a proper class that would GateType’Class.

I see. You are going to simulate deadlocks and live locks depending on…

evanescente-ondine · April 26, 2026, 4:31pm

You replied just before I corrected myself.
Funnily enough I arrived at the same practical solution. But the autistic in me will always find infuriating that legal constructs would fail. They should fix them before adding new dubious ones !! And I wouldn’t need half of it were task aggregates a thing.

I know… I’m just training my skills. It seems that any returning of class-wide limited types is broken, even this fails:

OrGate: Gatetype'Class := MakeGate (2, FnOr'Access, new Circuit'([theEnd'Access]), 1);

while a plain declaration doesn’t. Are all synchronized class hierarchies equally unusable ?

Irvise · April 26, 2026, 5:35pm

I recommend to open up a bug report under GCC with your code example as a reproducible. Reproducible bugs tend to get acknowledge quite quickly.

Best regards,
Fer

dmitry-kazakov · April 26, 2026, 6:26pm

One can imagine some use cases.

In general Java interfaces were a mistake. It should have been a full multiple inheritance. Ada 95 had abstract types already.

Protected and task types should have been regular tagged types. Unfortunately it is not quite clear how to extend them.

Bodies should have been extendable not just overridable. E.g. controlled types are obviously broken. You should not be able to override Initialize, Finalize, Adjust. With that fixed one could consider task bodies extensions.

Note also that Initialize and Finalize are inconsistent with strong typing. There should have been pairs of:

one to initialize/finalize a concrete instance T
another to initialize/finalize its class-wide view T’Class

The consequence of this conflation is that in practice you cannot have task components. A task component must terminate before Finalize. If there were a class-wide Finalize called before the type specific one, one could call task entries from there while the specific object is still fully operational.

This is the next issue you would probably run into. You should never use task components, always access to task. That caries a massive risk because such tasks usually have an access disctiminant of the container type (so-called Rosen’s trick). Again, if it were designed right you could inherit from a task rather aggregate it.

As you see it all is deeply interconnected and each language design bug brings more new ones.