OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes]

Browse Source 
2014-07-18  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch4.adb (Try_Container_Indexing): Refine previous patch for
	indexing over containers that are derived types: check whether
	signature of found operation has the correct first parameter
	before retrieving directly a primitive operation.

2014-07-18  Ed Schonberg  <schonberg@adacore.com>

	* sem_attr.adb (Analyze_Attribute, case 'Update): Set
	Do_Range_Check flag on dynamic bounds of a range used in a
	component association in the argument of Update.

2014-07-18  Thomas Quinot  <quinot@adacore.com>

	* adaint.c: #define _REENTRANT and _THREAD_SAFE in order for
	accesses to errno(3) to be thread safe.

2014-07-18  Vincent Celier  <celier@adacore.com>

	* prj-tree.adb (Imported_Or_Extended_Project_Of): For each non
	limited imported project that is an extending project, return
	a project being extended if it has the expected name.

2014-07-18  Pascal Obry  <obry@adacore.com>

	* s-os_lib.ads, s-os_lib.adb (Set_File_Last_Modify_Time_Stamp): New
	routine to set the last modification time stamp for the given file.
	* gnatchop.adb (File_Time_Stamp): Removed.
	(Write_Unit): Use
	Set_File_Last_Modify_Time_Stamp instead of ad-hoc implementation.

From-SVN: r212787
This commit is contained in:
Arnaud Charlet 2014-07-18 11:29:54 +02:00
parent 3f433bc07e
commit 6907542db4
8 changed files with 94 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
gcc/ada/ChangeLog
View File

@ -1,3 +1,35 @@
2014-07-18 Ed Schonberg <schonberg@adacore.com>
* sem_ch4.adb (Try_Container_Indexing): Refine previous patch for
indexing over containers that are derived types: check whether
signature of found operation has the correct first parameter
before retrieving directly a primitive operation.
2014-07-18 Ed Schonberg <schonberg@adacore.com>
* sem_attr.adb (Analyze_Attribute, case 'Update): Set
Do_Range_Check flag on dynamic bounds of a range used in a
component association in the argument of Update.
2014-07-18 Thomas Quinot <quinot@adacore.com>
* adaint.c: #define _REENTRANT and _THREAD_SAFE in order for
accesses to errno(3) to be thread safe.
2014-07-18 Vincent Celier <celier@adacore.com>
* prj-tree.adb (Imported_Or_Extended_Project_Of): For each non
limited imported project that is an extending project, return
a project being extended if it has the expected name.
2014-07-18 Pascal Obry <obry@adacore.com>
* s-os_lib.ads, s-os_lib.adb (Set_File_Last_Modify_Time_Stamp): New
routine to set the last modification time stamp for the given file.
* gnatchop.adb (File_Time_Stamp): Removed.
(Write_Unit): Use
Set_File_Last_Modify_Time_Stamp instead of ad-hoc implementation.
2014-07-18 Ed Schonberg <schonberg@adacore.com>
* sem_aggr.adb (Aggregate_Constraint_Checks): Moved to sem_util.

4
gcc/ada/adaint.c
View File

@ -34,6 +34,10 @@
package Osint. Many of the subprograms in OS_Lib import standard
library calls directly. This file contains all other routines. */
/* Ensure accesses to errno are thread safe. */
#define _REENTRANT
#define _THREAD_SAFE
#ifdef __vxworks
/* No need to redefine exit here. */

19
gcc/ada/gnatchop.adb
View File

@ -209,10 +209,6 @@ procedure Gnatchop is
procedure Error_Msg (Message : String; Warning : Boolean := False);
-- Produce an error message on standard error output
procedure File_Time_Stamp (Name : C_File_Name; Time : OS_Time);
-- Given the name of a file or directory, Name, set the
-- time stamp. This function must be used for an unopened file.
function Files_Exist return Boolean;
-- Check Unit.Table for possible file names that already exist
-- in the file system. Returns true if files exist, False otherwise
@ -372,18 +368,6 @@ procedure Gnatchop is
end if;
end Error_Msg;
---------------------
-- File_Time_Stamp --
---------------------
procedure File_Time_Stamp (Name : C_File_Name; Time : OS_Time) is
procedure Set_File_Time (Name : C_File_Name; Time : OS_Time);
pragma Import (C, Set_File_Time, "__gnat_set_file_time_name");
begin
Set_File_Time (Name, Time);
end File_Time_Stamp;
-----------------
-- Files_Exist --
-----------------
@ -1708,7 +1692,6 @@ procedure Gnatchop is
declare
E_Name : constant String := OS_Name (1 .. O_Length);
C_Name : aliased constant String := E_Name & ASCII.NUL;
OS_Encoding : constant String := Encoding (1 .. E_Length);
File : Stream_IO.File_Type;
@ -1776,7 +1759,7 @@ procedure Gnatchop is
Stream_IO.Close (File);
if Preserve_Mode then
File_Time_Stamp (C_Name'Address, TS_Time);
Set_File_Last_Modify_Time_Stamp (E_Name, TS_Time);
end if;
end;
end Write_Unit;

15
gcc/ada/prj-tree.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2001-2013, Free Software Foundation, Inc. --
-- Copyright (C) 2001-2014, 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- --
@ -1134,8 +1134,17 @@ package body Prj.Tree is
-- of variable or attributes.
Result := Non_Limited_Project_Node_Of (With_Clause, In_Tree);
exit when Present (Result)
and then Name_Of (Result, In_Tree) = With_Name;
while Present (Result) loop
if Name_Of (Result, In_Tree) = With_Name then
return Result;
end if;
Result :=
Extended_Project_Of
(Project_Declaration_Of (Result, In_Tree), In_Tree);
end loop;
With_Clause := Next_With_Clause_Of (With_Clause, In_Tree);
end loop;

14
gcc/ada/s-os_lib.adb
View File

@ -2385,6 +2385,20 @@ package body System.OS_Lib is
C_Set_Executable (C_Name (C_Name'First)'Address, Mode);
end Set_Executable;
-------------------------------------
-- Set_File_Last_Modify_Time_Stamp --
-------------------------------------
procedure Set_File_Last_Modify_Time_Stamp (Name : String; Time : OS_Time) is
procedure C_Set_File_Time (Name : C_File_Name; Time : OS_Time);
pragma Import (C, C_Set_File_Time, "__gnat_set_file_time_name");
C_Name : aliased String (Name'First .. Name'Last + 1);
begin
C_Name (Name'Range) := Name;
C_Name (C_Name'Last) := ASCII.NUL;
C_Set_File_Time (C_Name'Address, Time);
end Set_File_Last_Modify_Time_Stamp;
----------------------
-- Set_Non_Readable --
----------------------

4
gcc/ada/s-os_lib.ads
View File

@ -384,6 +384,10 @@ package System.OS_Lib is
-- Note: this procedure is not supported on VMS and VxWorks 5. On these
-- platforms, Success is always set to False.
procedure Set_File_Last_Modify_Time_Stamp (Name : String; Time : OS_Time);
-- Given the name of a file or directory, Name, set the last modification
-- time stamp. This function must be used for an unopened file.
function Read
(FD : File_Descriptor;
A : System.Address;

18
gcc/ada/sem_attr.adb
View File

@ -6314,6 +6314,7 @@ package body Sem_Attr is
declare
Index : Node_Id;
Index_Type : Entity_Id;
Lo, Hi : Node_Id;
begin
if Nkind (First (Choices (Assoc))) /= N_Aggregate then
@ -6331,11 +6332,18 @@ package body Sem_Attr is
Index := First (Choices (Assoc));
while Present (Index) loop
if Nkind (Index) = N_Range then
Analyze_And_Resolve
(Low_Bound (Index), Etype (Index_Type));
Analyze_And_Resolve
(High_Bound (Index), Etype (Index_Type));
Set_Etype (Index, Etype (Index_Type));
Lo := Low_Bound (Index);
Hi := High_Bound (Index);
Analyze_And_Resolve (Lo, Etype (Index_Type));
if not Is_OK_Static_Expression (Lo) then
Set_Do_Range_Check (Lo);
end if;
Analyze_And_Resolve (Hi, Etype (Index_Type));
if not Is_OK_Static_Expression (Hi) then
Set_Do_Range_Check (Hi);
end if;
else
Analyze_And_Resolve (Index, Etype (Index_Type));

17
gcc/ada/sem_ch4.adb
View File

@ -7021,13 +7021,24 @@ package body Sem_Ch4 is
return False;
end if;
-- If the container type is a derived type, the value of the inherited
-- aspect is the Reference operation declared for the parent type.
-- If the container type is derived from another container type, the
-- value of the inherited aspect is the Reference operation declared
-- for the parent type.
-- However, Reference is also a primitive operation of the type, and
-- the inherited operation has a different signature. We retrieve the
-- right one from the list of primitive operations of the derived type.
elsif Is_Derived_Type (Etype (Prefix)) then
-- Note that predefined containers are typically all derived from one
-- of the Controlled types. The code below is motivated by containers
-- that are derived from other types with a Reference aspect.
-- Additional machinery may be needed for types that have several user-
-- defined Reference operations with different signatures ???
elsif Is_Derived_Type (Etype (Prefix))
and then Etype (First_Formal (Entity (Func_Name))) /= Etype (Prefix)
then
Func := Find_Prim_Op (Etype (Prefix), Chars (Func_Name));
Func_Name := New_Occurrence_Of (Func, Loc);
end if;