1------------------------------------------------------------------------------ 2-- -- 3-- GNAT RUN-TIME COMPONENTS -- 4-- -- 5-- ADA.STRINGS.TEXT_OUTPUT.FILES -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 2020, Free Software Foundation, Inc. -- 10-- -- 11-- GNAT is free software; you can redistribute it and/or modify it under -- 12-- terms of the GNU General Public License as published by the Free Soft- -- 13-- ware Foundation; either version 3, or (at your option) any later ver- -- 14-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- 15-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- 16-- or FITNESS FOR A PARTICULAR PURPOSE. -- 17-- -- 18-- As a special exception under Section 7 of GPL version 3, you are granted -- 19-- additional permissions described in the GCC Runtime Library Exception, -- 20-- version 3.1, as published by the Free Software Foundation. -- 21-- -- 22-- You should have received a copy of the GNU General Public License and -- 23-- a copy of the GCC Runtime Library Exception along with this program; -- 24-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 25-- <http://www.gnu.org/licenses/>. -- 26-- -- 27-- GNAT was originally developed by the GNAT team at New York University. -- 28-- Extensive contributions were provided by Ada Core Technologies Inc. -- 29-- -- 30------------------------------------------------------------------------------ 31 32with Ada.Strings.Text_Output.Utils; use Ada.Strings.Text_Output.Utils; 33package body Ada.Strings.Text_Output.Files is 34 use type OS.File_Descriptor; 35 36 function Create_From_FD 37 (FD : OS.File_Descriptor; 38 Indent_Amount : Natural; 39 Chunk_Length : Positive) return File; 40 -- Create a file from an OS file descriptor 41 42 function Create_From_FD 43 (FD : OS.File_Descriptor; 44 Indent_Amount : Natural; 45 Chunk_Length : Positive) return File 46 is 47 begin 48 if FD = OS.Invalid_FD then 49 raise Program_Error with OS.Errno_Message; 50 end if; 51 return Result : File (Chunk_Length) do 52 Result.Indent_Amount := Indent_Amount; 53 Result.Cur_Chunk := Result.Initial_Chunk'Unchecked_Access; 54 Result.FD := FD; 55 end return; 56 end Create_From_FD; 57 58 function Create_File 59 (Name : String; 60 Indent_Amount : Natural := Default_Indent_Amount; 61 Chunk_Length : Positive := Default_Chunk_Length) return File 62 is 63 begin 64 return Create_From_FD 65 (OS.Create_File (Name, Fmode => OS.Text), 66 Indent_Amount, Chunk_Length); 67 end Create_File; 68 69 function Create_New_File 70 (Name : String; 71 Indent_Amount : Natural := Default_Indent_Amount; 72 Chunk_Length : Positive := Default_Chunk_Length) return File 73 is 74 begin 75 return Create_From_FD 76 (OS.Create_New_File (Name, Fmode => OS.Text), 77 Indent_Amount, Chunk_Length); 78 end Create_New_File; 79 80 overriding procedure Finalize (Ref : in out Self_Ref) is 81 begin 82 Close (Ref.Self.all); 83 end Finalize; 84 85 procedure Close (S : in out File'Class) is 86 Status : Boolean; 87 begin 88 Flush (S); 89 90 if S.FD not in OS.Standout | OS.Standerr then -- Don't close these 91 OS.Close (S.FD, Status); 92 if not Status then 93 raise Program_Error with OS.Errno_Message; 94 end if; 95 end if; 96 end Close; 97 98 overriding procedure Full_Method (S : in out File) renames Flush_Method; 99 100 overriding procedure Flush_Method (S : in out File) is 101 pragma Assert (S.Cur_Chunk = S.Initial_Chunk'Unchecked_Access); 102 Res : constant Integer := 103 OS.Write (S.FD, S.Cur_Chunk.Chars'Address, S.Last); 104 begin 105 if Res /= S.Last then 106 raise Program_Error with OS.Errno_Message; 107 end if; 108 S.Last := 0; 109 end Flush_Method; 110 111 The_Stdout : aliased File := 112 Create_From_FD (OS.Standout, 113 Indent_Amount => Default_Indent_Amount, 114 Chunk_Length => Default_Chunk_Length); 115 The_Stderr : aliased File := 116 Create_From_FD (OS.Standerr, 117 Indent_Amount => Default_Indent_Amount, 118 Chunk_Length => Default_Chunk_Length); 119 120 function Standard_Output return Sink_Access is (The_Stdout'Access); 121 function Standard_Error return Sink_Access is (The_Stderr'Access); 122 123end Ada.Strings.Text_Output.Files; 124