diff mbox series

[Ada] Add push/pop capability in Output

Message ID 20200723130204.GA68413@adacore.com
State New
Headers show
Series [Ada] Add push/pop capability in Output | expand

Commit Message

Arnaud Charlet July 23, 2020, 1:02 p.m. UTC 
Add the capability to use the Write_* procedures in an environment where
you want to write debugging info but still use them to write to other
files (such a C source files).

[changelog]

	* output.ads (Push_Output, Pop_Output): New procedures.
	* output.adb (FD_Array, FD_Stack, FD_Stack_Idx): New type and vars.
	(Push_Output, Pop_Output): New procedures.

Tested on x86_64-pc-linux-gnu, commited on trunk

---
 output.adb | 29 +++++++++++++++++++++++++++++
 output.ads |  9 +++++++++
 2 files changed, 38 insertions(+)
diff mbox series

Patch

diff --git output.adb output.adb
index d36aac8..971819b 100644
--- output.adb
+++ output.adb
@@ -45,6 +45,13 @@  package body Output is
    Current_FD : File_Descriptor := Standout;
    --  File descriptor for current output
 
+   type FD_Array is array (Nat range 1 .. 3) of File_Descriptor;
+   FD_Stack     : FD_Array;
+   FD_Stack_Idx : Nat := FD_Array'First - 1;
+   --  Maintain a small stack for Push_Output and Pop_Output. We'd normally
+   --  use Table for this and allow an unlimited depth, but we're the target
+   --  of a pragma Elaborate_All in Table, so we can't use it here.
+
    Special_Output_Proc : Output_Proc := null;
    --  Record argument to last call to Set_Special_Output. If this is
    --  non-null, then we are in special output mode.
@@ -228,6 +235,28 @@  procedure Outdent is
         (Cur_Indentation - Indentation_Amount) mod Indentation_Limit;
    end Outdent;
 
+   ----------------
+   -- Pop_Output --
+   ----------------
+
+   procedure Pop_Output is
+   begin
+      pragma Assert (FD_Stack_Idx >= FD_Array'First);
+      Current_FD := FD_Stack (FD_Stack_Idx);
+      FD_Stack_Idx := FD_Stack_Idx - 1;
+   end Pop_Output;
+
+   -----------------
+   -- Push_Output --
+   -----------------
+
+   procedure Push_Output is
+   begin
+      pragma Assert (FD_Stack_Idx < FD_Array'Last);
+      FD_Stack_Idx := FD_Stack_Idx + 1;
+      FD_Stack (FD_Stack_Idx) := Current_FD;
+   end Push_Output;
+
    ---------------------------
    -- Restore_Output_Buffer --
    ---------------------------
diff --git output.ads output.ads
index 4574cce..55d308a 100644
--- output.ads
+++ output.ads
@@ -95,6 +95,15 @@  procedure Set_Output (FD : File_Descriptor);
    --  output will appear on the given file descriptor only after special
    --  output has been cancelled.
 
+   procedure Push_Output;
+   --  Saves the current output destination on a stack, but leaves it
+   --  unchanged. This subprogram only supports a small stack and is normally
+   --  used with a depth of one.
+
+   procedure Pop_Output;
+   --  Changes the current output destination to be the last output destination
+   --  popped using Push_Output.
+
    procedure Indent;
    --  Increases the current indentation level. Whenever a line is written
    --  (triggered by Eol), an appropriate amount of whitespace is added to the