===================================================================
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
+-- Copyright (C) 2004-2010, 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- --
@@ -42,6 +42,7 @@ with Ada.Characters.Handling; use Ada
with System.CRTL; use System.CRTL;
with System.OS_Lib; use System.OS_Lib;
with System.Regexp; use System.Regexp;
+with System.File_IO; use System.File_IO;
with System;
@@ -301,9 +302,11 @@ package body Ada.Directories is
Target_Name : String;
Form : String := "")
is
- pragma Unreferenced (Form);
Success : Boolean;
+ Mode : Copy_Mode := Overwrite;
+ Preserve : Attribute := None;
+
begin
-- First, the invalid cases
@@ -322,10 +325,70 @@ package body Ada.Directories is
raise Use_Error with "target """ & Target_Name & """ is a directory";
else
- -- The implementation uses System.OS_Lib.Copy_File, with parameters
- -- suitable for all platforms.
+ if Form'Length > 0 then
+ declare
+ Formstr : String (1 .. Form'Length + 1);
+ V1, V2 : Natural;
+
+ begin
+
+ -- Acquire form string, setting required NUL terminator
+
+ Formstr (1 .. Form'Length) := Form;
+ Formstr (Formstr'Last) := ASCII.NUL;
+
+ -- Convert form string to lower case
+
+ for J in Formstr'Range loop
+ if Formstr (J) in 'A' .. 'Z' then
+ Formstr (J) :=
+ Character'Val (Character'Pos (Formstr (J)) + 32);
+ end if;
+ end loop;
+
+ -- Check Form
+
+ Form_Parameter (Formstr, "mode", V1, V2);
+
+ if V1 = 0 then
+ Mode := Overwrite;
+
+ elsif Formstr (V1 .. V2) = "copy" then
+ Mode := Copy;
+
+ elsif Formstr (V1 .. V2) = "overwrite" then
+ Mode := Overwrite;
+
+ elsif Formstr (V1 .. V2) = "append" then
+ Mode := Append;
+
+ else
+ raise Use_Error with "invalid Form";
+ end if;
+
+ Form_Parameter (Formstr, "preserve", V1, V2);
+
+ if V1 = 0 then
+ Preserve := None;
+
+ elsif Formstr (V1 .. V2) = "timestamps" then
+ Preserve := Time_Stamps;
+
+ elsif Formstr (V1 .. V2) = "all_attributes" then
+ Preserve := Full;
+
+ elsif Formstr (V1 .. V2) = "no_attributes" then
+ Preserve := None;
+
+ else
+ raise Use_Error with "invalid Form";
+ end if;
+ end;
+ end if;
+
+ -- The implementation uses System.OS_Lib.Copy_File
- Copy_File (Source_Name, Target_Name, Success, Overwrite, None);
+ Copy_File (Source_Name, Target_Name, Success, Mode, Preserve);
if not Success then
raise Use_Error with "copy of """ & Source_Name & """ failed";
===================================================================
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
+-- Copyright (C) 2004-2010, Free Software Foundation, Inc. --
-- --
-- This specification is derived for use with GNAT from AI-00248, which is --
-- expected to be a part of a future expected revised Ada Reference Manual. --
@@ -104,6 +104,8 @@ package Ada.Directories is
-- identification of a directory. The exception Use_Error is propagated if
-- the external environment does not support the creation of a directory
-- with the given name (in the absence of Name_Error) and form.
+ --
+ -- The Form parameter is ignored.
procedure Delete_Directory (Directory : String);
-- Deletes an existing empty directory with name Directory. The exception
@@ -129,6 +131,8 @@ package Ada.Directories is
-- The exception Use_Error is propagated if the external environment does
-- not support the creation of any directories with the given name (in the
-- absence of Name_Error) and form.
+ --
+ -- The Form parameter is ignored.
procedure Delete_Tree (Directory : String);
-- Deletes an existing directory with name Directory. The directory and
@@ -172,6 +176,41 @@ package Ada.Directories is
-- not support the creating of the file with the name given by Target_Name
-- and form given by Form, or copying of the file with the name given by
-- Source_Name (in the absence of Name_Error).
+ --
+ -- Interpretation of the Form parameter:
+ -- The Form parameter is case-insensitive.
+ -- Two fields are recognized in the Form parameter:
+ -- preserve=<value>
+ -- mode=<value>
+ -- <value> starts immediatey after the character '=' and ends with the
+ -- character immediatey preceding the next comma (',') or with the last
+ -- character of the parameter.
+ -- The only possible values for preserve= are:
+ -- no_attributes: do not try to preserve any file attributes. This is
+ -- the default if no preserve= is found in Form.
+ -- all_attributes: try to preserve all file attributes (timestamps,
+ -- access rights).
+ -- timestamps: preserve the timestamp of the copied file, but not the
+ -- other file attributes.
+ -- The only possible values for mode= are:
+ -- copy: only do the copy if the destination file does not already
+ -- exist. If it already exist, Copy_File fails.
+ -- overwrite: copy the file in all cases. Overwite an aready existing
+ -- destination file.
+ -- append: append the original file to the destination file. If the
+ -- destination file does not exist, the destination file is
+ -- a copy of the source file.
+ -- When mode=append, the field preserve=, if it exists, is not
+ -- taken into account.
+ -- If the Form parameter includes one or both of the fields and the value
+ -- or values are incorrect, Copy_file fails with Use_Error.
+ -- Examples of correct Forms:
+ -- Form => "preserve=no_attributes,mode=overwrite" (the default)
+ -- Form => "mode=append"
+ -- Form => "mode=copy, preserve=all_attributes"
+ -- Examples of incorrect Forms
+ -- Form => "preserve=junk"
+ -- Form => "mode=internal, preserve=timestamps"
----------------------------------------
-- File and directory name operations --