-- --
-- B o d y --
-- --
--- Copyright (C) 1998-2003 Ada Core Technologies, Inc. --
+-- Copyright (C) 1998-2005 Ada Core Technologies, Inc. --
-- --
-- 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- --
with Ada.Characters.Handling;
with Ada.Strings.Fixed;
with Ada.Strings.Maps;
+
with Unchecked_Deallocation;
with Unchecked_Conversion;
-with System; use System;
+
+with System; use System;
+with System.CRTL; use System.CRTL;
with GNAT.OS_Lib;
-----------
procedure Close (Dir : in out Dir_Type) is
-
- function closedir (Directory : System.Address) return Integer;
- pragma Import (C, closedir, "closedir");
-
Discard : Integer;
pragma Warnings (Off, Discard);
raise Directory_Error;
end if;
- Discard := closedir (System.Address (Dir.all));
+ Discard := closedir (DIRs (Dir.all));
Free (Dir);
end Close;
is
C_File_Name : constant String := Dir_Name & ASCII.NUL;
- function opendir
- (File_Name : String) return Dir_Type_Value;
- pragma Import (C, opendir, "opendir");
-
begin
- Dir := new Dir_Type_Value'(opendir (C_File_Name));
+ Dir := new Dir_Type_Value'(Dir_Type_Value (opendir (C_File_Name)));
if not Is_Open (Dir) then
Free (Dir);
Success : Boolean;
Working_Dir : Dir_Type;
- procedure rmdir (Dir_Name : String);
- pragma Import (C, rmdir, "rmdir");
-
begin
-- Remove the directory only if it is empty
-- --
-- B o d y --
-- --
--- Copyright (C) 1998-2004 Ada Core Technologies, Inc. --
+-- Copyright (C) 1998-2005 Ada Core Technologies, Inc. --
-- --
-- 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- --
with Gnatvsn;
with Hostparm;
+with System.CRTL; use System.CRTL;
+
procedure Gnatchop is
Terminate_Program : exception;
-- Note that this function returns false for the last entry.
procedure Sort_Units;
- -- Sort units and set up sorted unit table.
+ -- Sort units and set up sorted unit table
----------------------
-- File_Descriptors --
function dup (handle : File_Descriptor) return File_Descriptor;
function dup2 (from, to : File_Descriptor) return File_Descriptor;
- -- File descriptor based functions needed for redirecting stdin/stdout
-
- pragma Import (C, dup, "dup");
- pragma Import (C, dup2, "dup2");
---------------------
-- Local variables --
Success : out Boolean);
-- Write one compilation unit of the source to file
+ ---------
+ -- dup --
+ ---------
+
+ function dup (handle : File_Descriptor) return File_Descriptor is
+ begin
+ return File_Descriptor (System.CRTL.dup (int (handle)));
+ end dup;
+
+ ----------
+ -- dup2 --
+ ----------
+
+ function dup2 (from, to : File_Descriptor) return File_Descriptor is
+ begin
+ return File_Descriptor (System.CRTL.dup2 (int (from), int (to)));
+ end dup2;
+
---------------
-- Error_Msg --
---------------
Put_Line (Standard_Error, Gnatvsn.Gnat_Version_String);
Put_Line
(Standard_Error,
- "Copyright 1998-2004, Ada Core Technologies Inc.");
+ "Copyright 1998-2005, Ada Core Technologies Inc.");
when 'w' =>
Overwrite_Files := True;
Unit_Sort.Sort (Natural (Unit.Last));
- -- Set the Sorted_Index fields in the unit tables.
+ -- Set the Sorted_Index fields in the unit tables
for J in 1 .. SUnit_Num (Unit.Last) loop
Unit.Table (Sorted_Units.Table (J)).Sorted_Index := J;
-- --
-- B o d y --
-- --
--- Copyright (C) 1997-2004 Free Software Foundation, Inc. --
+-- Copyright (C) 1997-2005 Free Software Foundation, Inc. --
-- --
-- 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- --
Make_Path : String_Access;
procedure Create_Directory (Name : System.Address; Mode : Integer);
- pragma Import (C, Create_Directory, "mkdir");
+ pragma Import (C, Create_Directory, "decc$mkdir");
begin
if Argument_Count = 0 then
-- --
-- B o d y --
-- --
--- Copyright (C) 2004, Free Software Foundation, Inc. --
+-- Copyright (C) 2004-2005 Free Software Foundation, Inc. --
-- --
-- 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- --
------------------------------
function Popen (Command, Mode : System.Address) return System.Address;
- pragma Import (C, Popen);
+ pragma Import (C, Popen, "decc$popen");
function Pclose (File : System.Address) return Integer;
- pragma Import (C, Pclose);
+ pragma Import (C, Pclose, "decc$pclose");
---------------------
-- Archive_Builder --
-- --
-- S p e c --
-- --
--- Copyright (C) 2003 Free Software Foundation, Inc. --
+-- Copyright (C) 2003-2005 Free Software Foundation, Inc. --
-- --
-- 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- --
subtype chars is System.Address;
-- Pointer to null-terminated array of characters
+ subtype DIRs is System.Address;
+ -- Corresponds to the C type DIR*
+
subtype FILEs is System.Address;
-- Corresponds to the C type FILE*
procedure clearerr (stream : FILEs);
pragma Import (C, clearerr, "clearerr");
+ function closedir (directory : DIRs) return Integer;
+ pragma Import (C, closedir, "closedir");
+
+ function dup (handle : int) return int;
+ pragma Import (C, dup, "dup");
+
+ function dup2 (from, to : int) return int;
+ pragma Import (C, dup2, "dup2");
+
function fclose (stream : FILEs) return int;
pragma Import (C, fclose, "fclose");
procedure mktemp (template : chars);
pragma Import (C, mktemp, "mktemp");
+ function opendir (file_name : String) return DIRs;
+ pragma Import (C, opendir, "opendir");
+
function read (fd : int; buffer : chars; nbytes : int) return int;
pragma Import (C, read, "read");
procedure rewind (stream : FILEs);
pragma Import (C, rewind, "rewind");
+ procedure rmdir (dir_name : String);
+ pragma Import (C, rmdir, "rmdir");
+
function setvbuf
(stream : FILEs;
buffer : chars;