Examples of issues gnatstack can detect

Author: frank-at-adacore

courses/misc_tools/labs/200_gnatstack/cycles/cycles_example.adb

@@ -0,0 +1,32 @@
+package body Cycles_Example is
+
+   procedure Odd (Number : in out Integer) is
+   begin
+      Number := Number - 1;
+      if Number > 0
+      then
+         Cycles (Number);
+      end if;
+   end Odd;
+
+   procedure Even (Number : in out Integer) is
+   begin
+      Number := Number - 2;
+      if Number > 0
+      then
+         Cycles (Number);
+      end if;
+   end Even;
+
+   procedure Cycles (Number : in out Integer) is
+      Half : constant Integer := Number / 2;
+   begin
+      if Half * 2 = Number
+      then
+         Even (Number);
+      else
+         Odd (Number);
+      end if;
+   end Cycles;
+
+end Cycles_Example;

courses/misc_tools/labs/200_gnatstack/cycles/cycles_example.ads

@@ -0,0 +1,5 @@
+package Cycles_Example is
+
+   procedure Cycles (Number : in out Integer);
+
+end Cycles_Example;

courses/misc_tools/labs/200_gnatstack/cycles/cycles_main.adb

@@ -0,0 +1,6 @@
+with Cycles_Example;
+procedure Cycles_Main is
+   Number : Integer := 100;
+begin
+   Cycles_Example.Cycles (Number);
+end Cycles_Main;

courses/misc_tools/labs/200_gnatstack/dispatching/dispatching_example.adb

@@ -0,0 +1,30 @@
+package body Dispatching_Example is
+
+   procedure Primitive_One (Param : in out Primitive_T) is
+   begin
+      Param.Field := not Param.Field;
+      Primitive_Two (Param);
+      Primitive_Two (Primitive_T'Class (Param));
+   end Primitive_One;
+
+   procedure Primitive_Two (Param : in out Primitive_T) is
+   begin
+      null;
+      Param.Field := not Param.Field;
+   end Primitive_Two;
+
+   overriding procedure Primitive_Two (Param : in out Derived_T) is
+   begin
+      null;
+      Param.Field := not Param.Field;
+   end Primitive_Two;
+
+   procedure Calls is
+      One : Primitive_T;
+      Two : Derived_T;
+   begin
+      Primitive_One (One);
+      Primitive_One (Two);
+   end Calls;
+
+end Dispatching_Example;

courses/misc_tools/labs/200_gnatstack/dispatching/dispatching_example.ads

@@ -0,0 +1,14 @@
+package Dispatching_Example is
+
+   type Primitive_T is tagged record
+      Field : Boolean;
+   end record;
+   procedure Primitive_One (Param : in out Primitive_T);
+   procedure Primitive_Two (Param : in out Primitive_T);
+
+   type Derived_T is new Primitive_T with null record;
+   overriding procedure Primitive_Two (Param : in out Derived_T);
+
+   procedure Calls;
+
+end Dispatching_Example;

courses/misc_tools/labs/200_gnatstack/dispatching/dispatching_main.adb

@@ -0,0 +1,5 @@
+with Dispatching_Example;
+procedure Dispatching_Main is
+begin
+   Dispatching_Example.Calls;
+end Dispatching_Main;

courses/misc_tools/labs/200_gnatstack/indirect/indirect_example.adb

@@ -0,0 +1,29 @@
+package body Indirect_Example is
+
+   type Subprogram_Access_T is access procedure
+       (A, B :     Integer;
+        C    : out Boolean);
+   procedure Procedure_One
+     (A, B :     Integer;
+      C    : out Boolean) is
+   begin
+      C := A > B;
+   end Procedure_One;
+
+   procedure Procedure_Two
+     (A, B :     Integer;
+      C    : out Boolean) is
+   begin
+      C := A < B;
+   end Procedure_Two;
+
+   Calls : array (Boolean) of Subprogram_Access_T :=
+     (Procedure_One'Access,
+      Procedure_Two'Access);
+
+   procedure Test (Flag : in out Boolean) is
+   begin
+      Calls (Flag).all (1, 2, Flag);
+   end Test;
+
+end Indirect_Example;

courses/misc_tools/labs/200_gnatstack/indirect/indirect_example.ads

@@ -0,0 +1,5 @@
+package Indirect_Example is
+
+   procedure Test (Flag : in out Boolean);
+
+end Indirect_Example;

courses/misc_tools/labs/200_gnatstack/indirect/indirect_main.adb

@@ -0,0 +1,6 @@
+with Indirect_Example;
+procedure Indirect_Main is
+   Flag : Boolean := True;
+begin
+   Indirect_Example.Test (Flag);
+end Indirect_Main;

courses/misc_tools/labs/200_gnatstack/simple/main_unit.adb

@@ -0,0 +1,21 @@
+procedure Main_Unit is
+   type Data_Type is array (1 .. 5) of Integer;
+
+   function Inverse
+     (Input : Data_Type)
+      return Data_Type is
+      Result : Data_Type;
+   begin
+      for Index in Data_Type'Range
+      loop
+         Result (Index) := Input (Data_Type'Last - (Index - Data_Type'First));
+      end loop;
+
+      return Result;
+   end Inverse;
+
+   Data   : Data_Type := (1, 2, 3, 4, 5);
+   Result : Data_Type;
+begin
+   Result := Inverse (Data);
+end Main_Unit;