Commit 8cce3d75 by Arnaud Charlet

[multiple changes]

2010-09-09  Robert Dewar  <dewar@adacore.com>

	* sem_attr.adb: Minor reformatting.

2010-09-09  Thomas Quinot  <quinot@adacore.com>

	* socket.c (__gnat_socket_ioctl): On Darwin, the req parameter is an
	unsigned long, not an int.

2010-09-09  Vincent Celier  <celier@adacore.com>

	* make.adb, mlib-prj.adb, prj.adb, prj-nmsc.adb, mlib-tgt.adb,
	prj-conf.adb, prj-env.adb: Use Display_Name instead of Name whenever
	we are not checking for equality of path or file names.

2010-09-09  Ed Schonberg  <schonberg@adacore.com>

	* exp_util.adb (Remove_Side_Effects): If the expression is a packed
	array reference, reset the Analyzed flag so that it is properly
	expanded when the resulting object declaration is analyzed.

2010-09-09  Vincent Celier  <celier@adacore.com>

	* sinput-p.adb (Source_File_Is_Subunit): Return False if X is
	No_Source_File.

2010-09-09  Ramon Fernandez  <fernandez@adacore.com>

	* sysdep.c: The wrSbc8548 BSP in MILS doesn't know anything about the
	VX_SPE_TASK option, so disable it.

From-SVN: r164084
parent e6a96e55
2010-09-09 Robert Dewar <dewar@adacore.com>
* sem_attr.adb: Minor reformatting.
2010-09-09 Thomas Quinot <quinot@adacore.com>
* socket.c (__gnat_socket_ioctl): On Darwin, the req parameter is an
unsigned long, not an int.
2010-09-09 Vincent Celier <celier@adacore.com>
* make.adb, mlib-prj.adb, prj.adb, prj-nmsc.adb, mlib-tgt.adb,
prj-conf.adb, prj-env.adb: Use Display_Name instead of Name whenever
we are not checking for equality of path or file names.
2010-09-09 Ed Schonberg <schonberg@adacore.com>
* exp_util.adb (Remove_Side_Effects): If the expression is a packed
array reference, reset the Analyzed flag so that it is properly
expanded when the resulting object declaration is analyzed.
2010-09-09 Vincent Celier <celier@adacore.com>
* sinput-p.adb (Source_File_Is_Subunit): Return False if X is
No_Source_File.
2010-09-09 Ramon Fernandez <fernandez@adacore.com>
* sysdep.c: The wrSbc8548 BSP in MILS doesn't know anything about the
VX_SPE_TASK option, so disable it.
2010-09-09 Ed Schonberg <schonberg@adacore.com> 2010-09-09 Ed Schonberg <schonberg@adacore.com>
* sem.adb (Walk_Library_Items): Traverse context of subunits of the * sem.adb (Walk_Library_Items): Traverse context of subunits of the
......
...@@ -4777,6 +4777,18 @@ package body Exp_Util is ...@@ -4777,6 +4777,18 @@ package body Exp_Util is
Set_Etype (Def_Id, Exp_Type); Set_Etype (Def_Id, Exp_Type);
Res := New_Reference_To (Def_Id, Loc); Res := New_Reference_To (Def_Id, Loc);
-- If the expression is a packed reference, it must be reanalyzed
-- and expanded, depending on context. This is the case for actuals
-- where a constraint check may capture the actual before expansion
-- of the call is complete.
if Nkind (Exp) = N_Indexed_Component
and then Is_Packed (Etype (Prefix (Exp)))
then
Set_Analyzed (Exp, False);
Set_Analyzed (Prefix (Exp), False);
end if;
E := E :=
Make_Object_Declaration (Loc, Make_Object_Declaration (Loc,
Defining_Identifier => Def_Id, Defining_Identifier => Def_Id,
......
...@@ -1400,7 +1400,7 @@ package body Make is ...@@ -1400,7 +1400,7 @@ package body Make is
when Directory_Error => when Directory_Error =>
Make_Failed ("unable to change to object directory """ & Make_Failed ("unable to change to object directory """ &
Path_Or_File_Name Path_Or_File_Name
(Project.Object_Directory.Name) & (Project.Object_Directory.Display_Name) &
""" of project " & """ of project " &
Get_Name_String (Project.Display_Name)); Get_Name_String (Project.Display_Name));
end Change_To_Object_Directory; end Change_To_Object_Directory;
...@@ -2308,7 +2308,7 @@ package body Make is ...@@ -2308,7 +2308,7 @@ package body Make is
New_Args : Argument_List (1 .. Number); New_Args : Argument_List (1 .. Number);
Last_New : Natural := 0; Last_New : Natural := 0;
Dir_Path : constant String := Get_Name_String Dir_Path : constant String := Get_Name_String
(Arguments_Project.Directory.Name); (Arguments_Project.Directory.Display_Name);
begin begin
Current := Switches.Values; Current := Switches.Values;
...@@ -2351,7 +2351,8 @@ package body Make is ...@@ -2351,7 +2351,8 @@ package body Make is
(Name_Buffer (1 .. Name_Len))); (Name_Buffer (1 .. Name_Len)));
Dir_Path : constant String := Dir_Path : constant String :=
Get_Name_String Get_Name_String
(Arguments_Project.Directory.Name); (Arguments_Project.
Directory.Display_Name);
begin begin
Test_If_Relative_Path Test_If_Relative_Path
...@@ -3496,7 +3497,7 @@ package body Make is ...@@ -3496,7 +3497,7 @@ package body Make is
then then
Get_Name_String Get_Name_String
(Project_Of_Current_Object_Directory (Project_Of_Current_Object_Directory
.Object_Directory.Name); .Object_Directory.Display_Name);
Add_Str_To_Name_Buffer Add_Str_To_Name_Buffer
(Get_Name_String (Lib_File)); (Get_Name_String (Lib_File));
Full_Lib_File := Name_Find; Full_Lib_File := Name_Find;
...@@ -4373,7 +4374,7 @@ package body Make is ...@@ -4373,7 +4374,7 @@ package body Make is
Get_Name_String (ALI_Project.Library_Dir.Name); Get_Name_String (ALI_Project.Library_Dir.Name);
else else
Get_Name_String Get_Name_String
(ALI_Project.Object_Directory.Name); (ALI_Project.Object_Directory.Display_Name);
end if; end if;
if not if not
...@@ -5256,7 +5257,8 @@ package body Make is ...@@ -5256,7 +5257,8 @@ package body Make is
begin begin
if not Is_Absolute_Path (Exec_File_Name) then if not Is_Absolute_Path (Exec_File_Name) then
Get_Name_String (Main_Project.Exec_Directory.Name); Get_Name_String
(Main_Project.Exec_Directory.Display_Name);
if not if not
Is_Directory_Separator (Name_Buffer (Name_Len)) Is_Directory_Separator (Name_Buffer (Name_Len))
...@@ -5281,7 +5283,7 @@ package body Make is ...@@ -5281,7 +5283,7 @@ package body Make is
declare declare
Dir_Path : constant String := Dir_Path : constant String :=
Get_Name_String (Main_Project.Directory.Name); Get_Name_String (Main_Project.Directory.Display_Name);
begin begin
for J in 1 .. Binder_Switches.Last loop for J in 1 .. Binder_Switches.Last loop
Test_If_Relative_Path Test_If_Relative_Path
...@@ -6467,7 +6469,7 @@ package body Make is ...@@ -6467,7 +6469,7 @@ package body Make is
declare declare
Dir_Path : constant String := Dir_Path : constant String :=
Get_Name_String Get_Name_String
(Main_Project.Directory.Name); (Main_Project.Directory.Display_Name);
begin begin
for for
...@@ -6980,7 +6982,7 @@ package body Make is ...@@ -6980,7 +6982,7 @@ package body Make is
begin begin
Src_Ind := Sinput.P.Load_Project_File Src_Ind := Sinput.P.Load_Project_File
(Get_Name_String (Get_Name_String
(Unit.File_Names (Impl).Path.Name)); (Unit.File_Names (Impl).Path.Display_Name));
-- If it is a subunit, discard it -- If it is a subunit, discard it
......
...@@ -1374,12 +1374,12 @@ package body MLib.Prj is ...@@ -1374,12 +1374,12 @@ package body MLib.Prj is
(Object_Dir_Path (Object_Dir_Path
& Directory_Separator & Directory_Separator
& Filename (1 .. Last)); & Filename (1 .. Last));
Object_File : constant String :=
Filename (1 .. Last);
C_Object_Path : String := Object_Path; C_Filename : String := Object_File;
C_Filename : String := Filename (1 .. Last);
begin begin
Canonical_Case_File_Name (C_Object_Path);
Canonical_Case_File_Name (C_Filename); Canonical_Case_File_Name (C_Filename);
-- If in the object directory of an extended -- If in the object directory of an extended
...@@ -1390,20 +1390,17 @@ package body MLib.Prj is ...@@ -1390,20 +1390,17 @@ package body MLib.Prj is
or else or else
C_Filename (1 .. B_Start'Length) /= B_Start.all C_Filename (1 .. B_Start'Length) /= B_Start.all
then then
Name_Len := Last; Name_Len := 0;
Name_Buffer (1 .. Name_Len) := Add_Str_To_Name_Buffer (C_Filename);
C_Filename (1 .. Last);
Id := Name_Find; Id := Name_Find;
if not Objects_Htable.Get (Id) then if not Objects_Htable.Get (Id) then
declare declare
ALI_File : constant String := ALI_File : constant String :=
Ext_To Ext_To (C_Filename, "ali");
(C_Filename
(1 .. Last), "ali");
ALI_Path : constant String := ALI_Path : constant String :=
Ext_To (C_Object_Path, "ali"); Ext_To (Object_Path, "ali");
Add_It : Boolean; Add_It : Boolean;
Fname : File_Name_Type; Fname : File_Name_Type;
...@@ -1801,7 +1798,7 @@ package body MLib.Prj is ...@@ -1801,7 +1798,7 @@ package body MLib.Prj is
-- the library file and any ALI file of a source of the project. -- the library file and any ALI file of a source of the project.
begin begin
Get_Name_String (For_Project.Library_Dir.Name); Get_Name_String (For_Project.Library_Dir.Display_Name);
Change_Dir (Name_Buffer (1 .. Name_Len)); Change_Dir (Name_Buffer (1 .. Name_Len));
exception exception
...@@ -1942,7 +1939,7 @@ package body MLib.Prj is ...@@ -1942,7 +1939,7 @@ package body MLib.Prj is
Copy_ALI_Files Copy_ALI_Files
(Files => Ali_Files.all, (Files => Ali_Files.all,
To => For_Project.Library_ALI_Dir.Name, To => For_Project.Library_ALI_Dir.Display_Name,
Interfaces => Arguments (1 .. Argument_Number)); Interfaces => Arguments (1 .. Argument_Number));
-- Copy interface sources if Library_Src_Dir specified -- Copy interface sources if Library_Src_Dir specified
...@@ -1954,7 +1951,7 @@ package body MLib.Prj is ...@@ -1954,7 +1951,7 @@ package body MLib.Prj is
-- could be a source of the project. -- could be a source of the project.
begin begin
Get_Name_String (For_Project.Library_Src_Dir.Name); Get_Name_String (For_Project.Library_Src_Dir.Display_Name);
Change_Dir (Name_Buffer (1 .. Name_Len)); Change_Dir (Name_Buffer (1 .. Name_Len));
exception exception
...@@ -2085,7 +2082,8 @@ package body MLib.Prj is ...@@ -2085,7 +2082,8 @@ package body MLib.Prj is
Lib_Name : constant File_Name_Type := Lib_Name : constant File_Name_Type :=
Library_File_Name_For (For_Project, In_Tree); Library_File_Name_For (For_Project, In_Tree);
begin begin
Change_Dir (Get_Name_String (For_Project.Library_Dir.Name)); Change_Dir
(Get_Name_String (For_Project.Library_Dir.Display_Name));
Lib_TS := File_Stamp (Lib_Name); Lib_TS := File_Stamp (Lib_Name);
For_Project.Library_TS := Lib_TS; For_Project.Library_TS := Lib_TS;
end; end;
...@@ -2107,7 +2105,7 @@ package body MLib.Prj is ...@@ -2107,7 +2105,7 @@ package body MLib.Prj is
-- be Empty_Time_Stamp, earlier than any other time stamp. -- be Empty_Time_Stamp, earlier than any other time stamp.
Change_Dir Change_Dir
(Get_Name_String (For_Project.Object_Directory.Name)); (Get_Name_String (For_Project.Object_Directory.Display_Name));
Open (Dir => Object_Dir, Dir_Name => "."); Open (Dir => Object_Dir, Dir_Name => ".");
-- For all entries in the object directory -- For all entries in the object directory
...@@ -2212,7 +2210,7 @@ package body MLib.Prj is ...@@ -2212,7 +2210,7 @@ package body MLib.Prj is
begin begin
-- Change the working directory to the object directory -- Change the working directory to the object directory
Change_Dir (Get_Name_String (For_Project.Object_Directory.Name)); Change_Dir (Get_Name_String (For_Project.Object_Directory.Display_Name));
for Index in Interfaces'Range loop for Index in Interfaces'Range loop
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2001-2009, AdaCore -- -- Copyright (C) 2001-2010, AdaCore --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -343,7 +343,7 @@ package body MLib.Tgt is ...@@ -343,7 +343,7 @@ package body MLib.Tgt is
else else
declare declare
Lib_Dir : constant String := Lib_Dir : constant String :=
Get_Name_String (Project.Library_Dir.Name); Get_Name_String (Project.Library_Dir.Display_Name);
Lib_Name : constant String := Lib_Name : constant String :=
Get_Name_String (Project.Library_Name); Get_Name_String (Project.Library_Name);
......
...@@ -685,7 +685,7 @@ package body Prj.Conf is ...@@ -685,7 +685,7 @@ package body Prj.Conf is
-- First, find the object directory of the user's project -- First, find the object directory of the user's project
if Obj_Dir = Nil_Variable_Value or else Obj_Dir.Default then if Obj_Dir = Nil_Variable_Value or else Obj_Dir.Default then
Get_Name_String (Project.Directory.Name); Get_Name_String (Project.Directory.Display_Name);
else else
if Is_Absolute_Path (Get_Name_String (Obj_Dir.Value)) then if Is_Absolute_Path (Get_Name_String (Obj_Dir.Value)) then
...@@ -694,7 +694,7 @@ package body Prj.Conf is ...@@ -694,7 +694,7 @@ package body Prj.Conf is
else else
Name_Len := 0; Name_Len := 0;
Add_Str_To_Name_Buffer Add_Str_To_Name_Buffer
(Get_Name_String (Project.Directory.Name)); (Get_Name_String (Project.Directory.Display_Name));
Add_Str_To_Name_Buffer (Get_Name_String (Obj_Dir.Value)); Add_Str_To_Name_Buffer (Get_Name_String (Obj_Dir.Value));
end if; end if;
end if; end if;
......
...@@ -728,7 +728,7 @@ package body Prj.Env is ...@@ -728,7 +728,7 @@ package body Prj.Env is
Fmap.Add_To_File_Map Fmap.Add_To_File_Map
(Unit_Name => Unit_Name_Type (Data.Unit.Name), (Unit_Name => Unit_Name_Type (Data.Unit.Name),
File_Name => Data.File, File_Name => Data.File,
Path_Name => File_Name_Type (Data.Path.Name)); Path_Name => File_Name_Type (Data.Path.Display_Name));
end if; end if;
end if; end if;
...@@ -831,14 +831,14 @@ package body Prj.Env is ...@@ -831,14 +831,14 @@ package body Prj.Env is
Put_Name_Buffer; Put_Name_Buffer;
end if; end if;
Get_Name_String (Source.File); Get_Name_String (Source.Display_File);
Put_Name_Buffer; Put_Name_Buffer;
if Source.Locally_Removed then if Source.Locally_Removed then
Name_Len := 1; Name_Len := 1;
Name_Buffer (1) := '/'; Name_Buffer (1) := '/';
else else
Get_Name_String (Source.Path.Name); Get_Name_String (Source.Path.Display_Name);
end if; end if;
Put_Name_Buffer; Put_Name_Buffer;
......
...@@ -6877,7 +6877,7 @@ package body Prj.Nmsc is ...@@ -6877,7 +6877,7 @@ package body Prj.Nmsc is
and then Name_Loc.Source.Kind = Impl and then Name_Loc.Source.Kind = Impl
then then
Src_Ind := Sinput.P.Load_Project_File Src_Ind := Sinput.P.Load_Project_File
(Get_Name_String (Path)); (Get_Name_String (Display_Path));
if Sinput.P.Source_File_Is_Subunit (Src_Ind) then if Sinput.P.Source_File_Is_Subunit (Src_Ind) then
Override_Kind (Name_Loc.Source, Sep); Override_Kind (Name_Loc.Source, Sep);
...@@ -7380,7 +7380,7 @@ package body Prj.Nmsc is ...@@ -7380,7 +7380,7 @@ package body Prj.Nmsc is
Src_Ind := Src_Ind :=
Sinput.P.Load_Project_File Sinput.P.Load_Project_File
(Get_Name_String (Src_Id.Path.Name)); (Get_Name_String (Src_Id.Path.Display_Name));
if Sinput.P.Source_File_Is_Subunit (Src_Ind) then if Sinput.P.Source_File_Is_Subunit (Src_Ind) then
Override_Kind (Src_Id, Sep); Override_Kind (Src_Id, Sep);
......
...@@ -1015,11 +1015,11 @@ package body Prj is ...@@ -1015,11 +1015,11 @@ package body Prj is
if Project.Library then if Project.Library then
if Project.Object_Directory = No_Path_Information if Project.Object_Directory = No_Path_Information
or else Contains_ALI_Files (Project.Library_ALI_Dir.Name) or else Contains_ALI_Files (Project.Library_ALI_Dir.Display_Name)
then then
return Project.Library_ALI_Dir.Name; return Project.Library_ALI_Dir.Display_Name;
else else
return Project.Object_Directory.Name; return Project.Object_Directory.Display_Name;
end if; end if;
-- For a non-library project, add object directory if it is not a -- For a non-library project, add object directory if it is not a
......
...@@ -7930,8 +7930,6 @@ package body Sem_Attr is ...@@ -7930,8 +7930,6 @@ package body Sem_Attr is
-- didn't permit the access to be declared in the generic -- didn't permit the access to be declared in the generic
-- spec, whereas the revised rule does (as long as it's not -- spec, whereas the revised rule does (as long as it's not
-- a formal type). -- a formal type).
-- Note that we relax this check in CodePeer mode for
-- compatibility with legacy code.
-- There are a couple of subtleties of the test for applying -- There are a couple of subtleties of the test for applying
-- the check that are worth noting. First, we only apply it -- the check that are worth noting. First, we only apply it
...@@ -7951,6 +7949,12 @@ package body Sem_Attr is ...@@ -7951,6 +7949,12 @@ package body Sem_Attr is
-- when within an instance, because any violations will have -- when within an instance, because any violations will have
-- been caught by the compilation of the generic unit. -- been caught by the compilation of the generic unit.
-- Note that we relax this check in CodePeer mode for
-- compatibility with legacy code.
-- This seems an odd decision??? Why should codepeer mode
-- have a different notion of legality from the compiler???
elsif Attr_Id = Attribute_Access elsif Attr_Id = Attribute_Access
and then not CodePeer_Mode and then not CodePeer_Mode
and then not In_Instance and then not In_Instance
...@@ -7969,9 +7973,9 @@ package body Sem_Attr is ...@@ -7969,9 +7973,9 @@ package body Sem_Attr is
-- The attribute type's ultimate ancestor must be -- The attribute type's ultimate ancestor must be
-- declared within the same generic unit as the -- declared within the same generic unit as the
-- subprogram is declared. The error message is -- subprogram is declared. The error message is
-- specialized to say "ancestor" for the case where -- specialized to say "ancestor" for the case where the
-- the access type is not its own ancestor, since -- access type is not its own ancestor, since saying
-- saying simply "access type" would be very confusing. -- simply "access type" would be very confusing.
if Enclosing_Generic_Unit (Entity (P)) /= if Enclosing_Generic_Unit (Entity (P)) /=
Enclosing_Generic_Unit (Root_Type (Btyp)) Enclosing_Generic_Unit (Root_Type (Btyp))
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2008, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -151,6 +151,12 @@ package body Sinput.P is ...@@ -151,6 +151,12 @@ package body Sinput.P is
function Source_File_Is_Subunit (X : Source_File_Index) return Boolean is function Source_File_Is_Subunit (X : Source_File_Index) return Boolean is
begin begin
-- Nothing to do if X is null. So, simply return False.
if X = No_Source_File then
return False;
end if;
Prj.Err.Scanner.Initialize_Scanner (X); Prj.Err.Scanner.Initialize_Scanner (X);
-- No error for special characters that are used for preprocessing -- No error for special characters that are used for preprocessing
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
* * * *
* C Implementation File * * C Implementation File *
* * * *
* Copyright (C) 2003-2009, Free Software Foundation, Inc. * * Copyright (C) 2003-2010, Free Software Foundation, Inc. *
* * * *
* GNAT is free software; you can redistribute it and/or modify it under * * 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- * * terms of the GNU General Public License as published by the Free Soft- *
...@@ -529,6 +529,12 @@ int ...@@ -529,6 +529,12 @@ int
__gnat_socket_ioctl (int fd, int req, int *arg) { __gnat_socket_ioctl (int fd, int req, int *arg) {
#if defined (_WIN32) #if defined (_WIN32)
return ioctlsocket (fd, req, arg); return ioctlsocket (fd, req, arg);
#elif defined (__APPLE__)
/*
* On Darwin, req is an unsigned long, and we want to convert without sign
* extension to get the proper bit pattern in the case of a 64 bit kernel.
*/
return ioctl (fd, (unsigned int) req, arg);
#else #else
return ioctl (fd, req, arg); return ioctl (fd, req, arg);
#endif #endif
......
...@@ -959,7 +959,7 @@ __gnat_get_task_options (void) ...@@ -959,7 +959,7 @@ __gnat_get_task_options (void)
/* Force VX_FP_TASK because it is almost always required */ /* Force VX_FP_TASK because it is almost always required */
options |= VX_FP_TASK; options |= VX_FP_TASK;
#if defined (__SPE__) #if defined (__SPE__) && (! defined (__VXWORKSMILS__))
options |= VX_SPE_TASK; options |= VX_SPE_TASK;
#endif #endif
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment