[multiple changes]

2010-10-04  Vincent Celier  <celier@adacore.com>

	* a-direct.adb (Copy_File): Interpret the Form parameter and call
	System.OS_Lib.Copy_File to do the work accordingly. Raise Use_Error if
	the Form parameter contains an incorrect value for field preserve= or
	mode=.
	* a-direct.ads (Create_Directory, Create_Path): Indicate that the Form
	parameter is ignored.
	(Copy_File): Indicate the interpretation of the Form parameter.

2010-10-04  Vincent Celier  <celier@adacore.com>

	* make.adb (Gnatmake): When there are no foreign languages declared and
	a main in attribute Main of the main project does not exist or is a
	source of another project, fail immediately before attempting
	compilation.

2010-10-04  Javier Miranda  <miranda@adacore.com>

	* exp_disp.ads (Convert_Tag_To_Interface): New function which must be
	used to convert a node referencing a tag to a class-wide interface type.
	* exp_disp.adb (Convert_Tag_To_Interface): New function.
	(Expand_Interface_Conversion): Replace invocation of
	Unchecked_Conversion by new function Convert_Tag_To_Interface.
	(Write_DT): Add support for null primitives.
	* exp_ch3.adb (Expand_N_Object_Declaration): For tagged type objects,
	cleanup code that handles interface conversions and avoid unchecked
	conversion of referenced tag components.
	* exp_ch5.adb (Expand_N_Assignment_Statement): Code cleanup. Avoid
	unrequired conversions when generating a dispatching call to _assign.
	* sprint.adb (Write_Itype): Fix wrong output of not null access itypes.

2010-10-04  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch4.adb (Expand_N_Op_Not): Handle properly both operands when the
	parent is a binary boolean operation and the operand is an unpacked
	array.
	(Build_Boolean_Array_Proc_Call): If the operands are both negations, the
	operands of the rewritten node are the operands of the negations, not
	the negations themselves.

From-SVN: r164942

1 files changed, 68 insertions, 5 deletions

diff --git a/gcc/ada/a-direct.adb b/gcc/ada/a-direct.adb
index 1013b15..c2c19d9 100644
--- a/gcc/ada/a-direct.adb
+++ b/gcc/ada/a-direct.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2004-2009, Free Software Foundation, Inc.         --
+--          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.Characters.Handling;
 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";