--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/gcc/ada/libgnat/g-cgideb.adb	Fri Oct 27 22:46:09 2017 +0900
@@ -0,0 +1,314 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                        G N A T . C G I . D E B U G                       --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--                     Copyright (C) 2000-2017, AdaCore                     --
+--                                                                          --
+-- GNAT is free software;  you can  redistribute it  and/or modify it under --
+-- terms of the  GNU General Public License as published  by the Free Soft- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
+--                                                                          --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception,   --
+-- version 3.1, as published by the Free Software Foundation.               --
+--                                                                          --
+-- You should have received a copy of the GNU General Public License and    --
+-- a copy of the GCC Runtime Library Exception along with this program;     --
+-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
+-- <http://www.gnu.org/licenses/>.                                          --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+with Ada.Strings.Unbounded;
+
+package body GNAT.CGI.Debug is
+
+   use Ada.Strings.Unbounded;
+
+   --  Define the abstract type which act as a template for all debug IO modes.
+   --  To create a new IO mode you must:
+   --     1. create a new package spec
+   --     2. create a new type derived from IO.Format
+   --     3. implement all the abstract routines in IO
+
+   package IO is
+
+      type Format is abstract tagged null record;
+
+      function Output (Mode : Format'Class) return String;
+
+      function Variable
+        (Mode  : Format;
+         Name  : String;
+         Value : String) return String is abstract;
+      --  Returns variable Name and its associated value
+
+      function New_Line (Mode : Format) return String is abstract;
+      --  Returns a new line such as this concatenated between two strings
+      --  will display the strings on two lines.
+
+      function Title (Mode : Format; Str : String) return String is abstract;
+      --  Returns Str as a Title. A title must be alone and centered on a
+      --  line. Next output will be on the following line.
+
+      function Header
+        (Mode : Format;
+         Str  : String) return String is abstract;
+      --  Returns Str as an Header. An header must be alone on its line. Next
+      --  output will be on the following line.
+
+   end IO;
+
+   ----------------------
+   -- IO for HTML Mode --
+   ----------------------
+
+   package HTML_IO is
+
+      --  See IO for comments about these routines
+
+      type Format is new IO.Format with null record;
+
+      function Variable
+        (IO    : Format;
+         Name  : String;
+         Value : String) return String;
+
+      function New_Line (IO : Format) return String;
+
+      function Title (IO : Format; Str : String) return String;
+
+      function Header (IO : Format; Str : String) return String;
+
+   end HTML_IO;
+
+   ----------------------------
+   -- IO for Plain Text Mode --
+   ----------------------------
+
+   package Text_IO is
+
+      --  See IO for comments about these routines
+
+      type Format is new IO.Format with null record;
+
+      function Variable
+        (IO    : Format;
+         Name  : String;
+         Value : String) return String;
+
+      function New_Line (IO : Format) return String;
+
+      function Title (IO : Format; Str : String) return String;
+
+      function Header (IO : Format; Str : String) return String;
+
+   end Text_IO;
+
+   --------------
+   -- Debug_IO --
+   --------------
+
+   package body IO is
+
+      ------------
+      -- Output --
+      ------------
+
+      function Output (Mode : Format'Class) return String is
+         Result : Unbounded_String;
+
+      begin
+         Result :=
+           To_Unbounded_String
+             (Title (Mode, "CGI complete runtime environment")
+              & Header (Mode, "CGI parameters:")
+              & New_Line (Mode));
+
+         for K in 1 .. Argument_Count loop
+            Result := Result
+              & Variable (Mode, Key (K), Value (K))
+              & New_Line (Mode);
+         end loop;
+
+         Result := Result
+           & New_Line (Mode)
+           & Header (Mode, "CGI environment variables (Metavariables):")
+           & New_Line (Mode);
+
+         for P in Metavariable_Name'Range loop
+            if Metavariable_Exists (P) then
+               Result := Result
+                 & Variable (Mode,
+                             Metavariable_Name'Image (P),
+                             Metavariable (P))
+                 & New_Line (Mode);
+            end if;
+         end loop;
+
+         return To_String (Result);
+      end Output;
+
+   end IO;
+
+   -------------
+   -- HTML_IO --
+   -------------
+
+   package body HTML_IO is
+
+      NL : constant String := (1 => ASCII.LF);
+
+      function Bold (S : String) return String;
+      --  Returns S as an HTML bold string
+
+      function Italic (S : String) return String;
+      --  Returns S as an HTML italic string
+
+      ----------
+      -- Bold --
+      ----------
+
+      function Bold (S : String) return String is
+      begin
+         return "<b>" & S & "</b>";
+      end Bold;
+
+      ------------
+      -- Header --
+      ------------
+
+      function Header (IO : Format; Str : String) return String is
+         pragma Unreferenced (IO);
+      begin
+         return "<h2>" & Str & "</h2>" & NL;
+      end Header;
+
+      ------------
+      -- Italic --
+      ------------
+
+      function Italic (S : String) return String is
+      begin
+         return "<i>" & S & "</i>";
+      end Italic;
+
+      --------------
+      -- New_Line --
+      --------------
+
+      function New_Line (IO : Format) return String is
+         pragma Unreferenced (IO);
+      begin
+         return "<br>" & NL;
+      end New_Line;
+
+      -----------
+      -- Title --
+      -----------
+
+      function Title (IO : Format; Str : String) return String is
+         pragma Unreferenced (IO);
+      begin
+         return "<p align=center><font size=+2>" & Str & "</font></p>" & NL;
+      end Title;
+
+      --------------
+      -- Variable --
+      --------------
+
+      function Variable
+        (IO    : Format;
+         Name  : String;
+         Value : String) return String
+      is
+         pragma Unreferenced (IO);
+      begin
+         return Bold (Name) & " = " & Italic (Value);
+      end Variable;
+
+   end HTML_IO;
+
+   -------------
+   -- Text_IO --
+   -------------
+
+   package body Text_IO is
+
+      ------------
+      -- Header --
+      ------------
+
+      function Header (IO : Format; Str : String) return String is
+      begin
+         return "*** " & Str & New_Line (IO);
+      end Header;
+
+      --------------
+      -- New_Line --
+      --------------
+
+      function New_Line (IO : Format) return String is
+         pragma Unreferenced (IO);
+      begin
+         return String'(1 => ASCII.LF);
+      end New_Line;
+
+      -----------
+      -- Title --
+      -----------
+
+      function Title (IO : Format; Str : String) return String is
+         Spaces : constant Natural := (80 - Str'Length) / 2;
+         Indent : constant String (1 .. Spaces) := (others => ' ');
+      begin
+         return Indent & Str & New_Line (IO);
+      end Title;
+
+      --------------
+      -- Variable --
+      --------------
+
+      function Variable
+        (IO    : Format;
+         Name  : String;
+         Value : String) return String
+      is
+         pragma Unreferenced (IO);
+      begin
+         return "   " & Name & " = " & Value;
+      end Variable;
+
+   end Text_IO;
+
+   -----------------
+   -- HTML_Output --
+   -----------------
+
+   function HTML_Output return String is
+      HTML : HTML_IO.Format;
+   begin
+      return IO.Output (Mode => HTML);
+   end HTML_Output;
+
+   -----------------
+   -- Text_Output --
+   -----------------
+
+   function Text_Output return String is
+      Text : Text_IO.Format;
+   begin
+      return IO.Output (Mode => Text);
+   end Text_Output;
+
+end GNAT.CGI.Debug;