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

[multiple changes] 

2004-01-13  Ed Schonberg  <schonberg@gnat.com>

	* exp_ch3.adb (Build_Assignment): Fix bug in handling of controlled
	components that are initialized with aggregates.

2004-01-13  Vincent Celier  <celier@gnat.com>

	* gnatlink.adb (Process_Binder_File): To find directory of shared
	libgcc, if "gcc-lib" is not a subdirectory, look for the last
	subdirectory "lib" in the path of the shared libgnat or libgnarl.

	* make.adb (Gnatmake): If GCC version is at least 3, link with
	-shared-libgcc, when there is at least one shared library project.

	* opt.ads (GCC_Version): New integer constant.

	* adaint.c (get_gcc_version): New function.

2004-01-13  Robert Dewar  <dewar@gnat.com>

	* sem_dist.adb, sem_res.adb, sem_util.adb,
	sprint.adb, 3zsocthi.adb, einfo.adb, cstand.adb,
	exp_ch4.adb, exp_ch9.adb, exp_dist.adb: Minor reformatting

2004-01-13  Thomas Quinot  <quinot@act-europe.fr>

	* s-interr.adb, s-stache.adb, s-taenca.adb, g-regpat.adb,
	g-spitbo.adb, 5itaprop.adb: Add missing 'constant' keywords in object
	declarations.

From-SVN: r75802
This commit is contained in:
Arnaud Charlet 2004-01-13 12:51:34 +01:00
parent 0115e4700b
commit 9bc43c535e
22 changed files with 150 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
gcc/ada/3zsocthi.adb
View File

@ -64,7 +64,7 @@ package body GNAT.Sockets.Thin is
Thread_Blocking_IO : Boolean := True;
Unknown_System_Error : constant C.Strings.chars_ptr :=
C.Strings.New_String ("Unknown system error");
C.Strings.New_String ("Unknown system error");
-- The following types and variables are required to create a Hostent
-- record "by hand".

2
gcc/ada/5itaprop.adb
View File

@ -201,7 +201,7 @@ package body System.Task_Primitives.Operations is
procedure Abort_Handler (signo : Signal) is
pragma Unreferenced (signo);
Self_Id : Task_ID := Self;
Self_Id : constant Task_ID := Self;
Result : Interfaces.C.int;
Old_Set : aliased sigset_t;

30
gcc/ada/ChangeLog
View File

@ -1,3 +1,33 @@
2004-01-13 Ed Schonberg <schonberg@gnat.com>
* exp_ch3.adb (Build_Assignment): Fix bug in handling of controlled
components that are initialized with aggregates.
2004-01-13 Vincent Celier <celier@gnat.com>
* gnatlink.adb (Process_Binder_File): To find directory of shared
libgcc, if "gcc-lib" is not a subdirectory, look for the last
subdirectory "lib" in the path of the shared libgnat or libgnarl.
* make.adb (Gnatmake): If GCC version is at least 3, link with
-shared-libgcc, when there is at least one shared library project.
* opt.ads (GCC_Version): New integer constant.
* adaint.c (get_gcc_version): New function.
2004-01-13 Robert Dewar <dewar@gnat.com>
* sem_dist.adb, sem_res.adb, sem_util.adb,
sprint.adb, 3zsocthi.adb, einfo.adb, cstand.adb,
exp_ch4.adb, exp_ch9.adb, exp_dist.adb: Minor reformatting
2004-01-13 Thomas Quinot <quinot@act-europe.fr>
* s-interr.adb, s-stache.adb, s-taenca.adb, g-regpat.adb,
g-spitbo.adb, 5itaprop.adb: Add missing 'constant' keywords in object
declarations.
2004-01-12 Arnaud Charlet <charlet@act-europe.fr>
* misc.c: Remove trailing spaces.

10
gcc/ada/adaint.c
View File

@ -6,7 +6,7 @@
* *
* C Implementation File *
* *
* Copyright (C) 1992-2003, Free Software Foundation, Inc. *
* Copyright (C) 1992-2004, 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- *
@ -2487,3 +2487,11 @@ __gnat_lseek (int fd, long offset, int whence)
{
return (int) lseek (fd, offset, whence);
}
/* This function returns the version of GCC being used. Here it's GCC 3. */
int
get_gcc_version (void)
{
return 3;
}

2
gcc/ada/cstand.adb
View File

@ -559,6 +559,7 @@ package body CStand is
-- Create type definition node for type String
Tdef_Node := New_Node (N_Unconstrained_Array_Definition, Stloc);
declare
CompDef_Node : Node_Id;
begin
@ -567,6 +568,7 @@ package body CStand is
Set_Subtype_Indication (CompDef_Node, Identifier_For (S_Character));
Set_Component_Definition (Tdef_Node, CompDef_Node);
end;
Set_Subtype_Marks (Tdef_Node, New_List);
Append (Identifier_For (S_Positive), Subtype_Marks (Tdef_Node));
Set_Type_Definition (Parent (Standard_String), Tdef_Node);

4
gcc/ada/einfo.adb
View File

@ -6,14 +6,14 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2003 Free Software Foundation, Inc. --
-- Copyright (C) 1992-2004 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- --
-- ware Foundation; either version 2, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A CPARTICULAR PURPOSE. See the GNU General Public License --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --

2
gcc/ada/exp_ch3.adb
View File

@ -1527,7 +1527,7 @@ package body Exp_Ch3 is
-- aggregate that will be expanded inline
if Kind = N_Qualified_Expression then
Kind := Nkind (Parent (N));
Kind := Nkind (Expression (N));
end if;
if Controlled_Type (Typ)

5
gcc/ada/exp_ch4.adb
View File

@ -654,7 +654,8 @@ package body Exp_Ch4 is
Comp : RE_Id;
Stg_Unit_Is_Byte : constant Boolean := System_Storage_Unit = Byte'Size;
Byte_Addressable : constant Boolean := System_Storage_Unit = Byte'Size;
-- True for byte addressable target
function Length_Less_Than_4 (Opnd : Node_Id) return Boolean;
-- Returns True if the length of the given operand is known to be
@ -707,7 +708,7 @@ package body Exp_Ch4 is
-- addressing of array components.
if not Is_Bit_Packed_Array (Typ1)
and then Stg_Unit_Is_Byte
and then Byte_Addressable
and then not Java_VM
then
-- The call we generate is:

12
gcc/ada/exp_ch9.adb
View File

@ -2612,10 +2612,10 @@ package body Exp_Ch9 is
(Parent (Efam)))), Loc))),
Component_Definition =>
Make_Component_Definition (Loc,
Aliased_Present => False,
Subtype_Indication =>
New_Reference_To (Standard_Character, Loc))));
Make_Component_Definition (Loc,
Aliased_Present => False,
Subtype_Indication =>
New_Reference_To (Standard_Character, Loc))));
Insert_After (Current_Node, Efam_Decl);
Current_Node := Efam_Decl;
@ -2629,10 +2629,12 @@ package body Exp_Ch9 is
Component_Definition =>
Make_Component_Definition (Loc,
Aliased_Present => False,
Subtype_Indication =>
Make_Subtype_Indication (Loc,
Subtype_Mark =>
New_Occurrence_Of (Efam_Type, Loc),
Constraint =>
Make_Index_Or_Discriminant_Constraint (Loc,
Constraints => New_List (
@ -7283,11 +7285,13 @@ package body Exp_Ch9 is
Make_Component_Declaration (Loc,
Defining_Identifier =>
Make_Defining_Identifier (Loc, Name_uTask_Info),
Component_Definition =>
Make_Component_Definition (Loc,
Aliased_Present => False,
Subtype_Indication =>
New_Reference_To (RTE (RE_Task_Info_Type), Loc)),
Expression => New_Copy (
Expression (First (
Pragma_Argument_Associations (

6
gcc/ada/exp_dist.adb
View File

@ -55,17 +55,19 @@ package body Exp_Dist is
-- The following model has been used to implement distributed objects:
-- given a designated type D and a RACW type R, then a record of the
-- form:
-- type Stub is tagged record
-- [...declaration similar to s-parint.ads RACW_Stub_Type...]
-- end record;
-- is built. This type has two properties:
--
-- 1) Since it has the same structure than RACW_Stub_Type, it can be
-- converted to and from this type to make it suitable for
-- System.Partition_Interface.Get_Unique_Remote_Pointer in order
-- to avoid memory leaks when the same remote object arrive on the
-- same partition by following different pathes
--
-- 2) It also has the same dispatching table as the designated type D,
-- and thus can be used as an object designated by a value of type
-- R on any partition other than the one on which the object has

6
gcc/ada/g-regpat.adb
View File

@ -2997,9 +2997,9 @@ package body GNAT.Regpat is
function Match_Whilem (IP : Pointer) return Boolean is
pragma Unreferenced (IP);
Cc : Current_Curly_Access := Current_Curly;
N : constant Natural := Cc.Cur + 1;
Ln : Natural := 0;
Cc : constant Current_Curly_Access := Current_Curly;
N : constant Natural := Cc.Cur + 1;
Ln : Natural := 0;
Lastloc : constant Natural := Cc.Lastloc;
-- Detection of 0-len.

2
gcc/ada/g-spitbo.adb
View File

@ -169,7 +169,7 @@ package body GNAT.Spitbol is
procedure Reverse_String (Str : in out VString) is
Len : constant Natural := Length (Str);
Chars : String_Access := Get_String (Str);
Chars : constant String_Access := Get_String (Str);
Temp : Character;
begin

46
gcc/ada/gnatlink.adb
View File

@ -678,7 +678,7 @@ procedure Gnatlink is
-- terminator.
function Index (S, Pattern : String) return Natural;
-- Return the first occurrence of Pattern in S, or 0 if none.
-- Return the last occurrence of Pattern in S, or 0 if none.
function Is_Option_Present (Opt : in String) return Boolean;
-- Return true if the option Opt is already present in
@ -727,8 +727,9 @@ procedure Gnatlink is
function Index (S, Pattern : String) return Natural is
Len : constant Natural := Pattern'Length;
begin
for J in S'First .. S'Last - Len + 1 loop
for J in reverse S'First .. S'Last - Len + 1 loop
if Pattern = S (J .. J + Len - 1) then
return J;
end if;
@ -1061,7 +1062,42 @@ procedure Gnatlink is
-- Also add path to find libgcc_s.so, if
-- relevant.
GCC_Index := Index (File_Path.all, "gcc-lib");
-- To find the location of the shared version
-- of libgcc, we look for "gcc-lib" in the
-- path of the library. However, this
-- subdirectory is no longer present in
-- in recent version of GCC. So, we look for
-- the last subdirectory "lib" in the path.
GCC_Index :=
Index (File_Path.all, "gcc-lib");
if GCC_Index /= 0 then
-- The shared version of libgcc is
-- located in the parent directory.
GCC_Index := GCC_Index - 1;
else
GCC_Index :=
Index (File_Path.all, "/lib/");
if GCC_Index = 0 then
GCC_Index :=
Index (File_Path.all,
Directory_Separator &
"lib" &
Directory_Separator);
end if;
-- We have found a subdirectory "lib",
-- this is where the shared version of
-- libgcc should be located.
if GCC_Index /= 0 then
GCC_Index := GCC_Index + 3;
end if;
end if;
-- Look for an eventual run_path_option in
-- the linker switches.
@ -1124,7 +1160,7 @@ procedure Gnatlink is
(1 .. File_Path'Length
- File_Name'Length)
& Path_Separator
& File_Path (1 .. GCC_Index - 1));
& File_Path (1 .. GCC_Index));
else
Linker_Options.Table
@ -1137,7 +1173,7 @@ procedure Gnatlink is
(1 .. File_Path'Length
- File_Name'Length)
& Path_Separator
& File_Path (1 .. GCC_Index - 1));
& File_Path (1 .. GCC_Index));
end if;
end if;
end if;

19
gcc/ada/make.adb
View File

@ -393,6 +393,14 @@ package body Make is
Bind_Shared_Known : Boolean := False;
-- Set to True after the first time Bind_Shared is computed
Shared_Libgcc : aliased String := "-shared-libgcc";
No_Shared_Libgcc_Switch : aliased Argument_List := (1 .. 0 => null);
Shared_Libgcc_Switch : aliased Argument_List :=
(1 => Shared_Libgcc'Access);
Link_With_Shared_Libgcc : Argument_List_Access :=
No_Shared_Libgcc_Switch'Access;
procedure Make_Failed (S1 : String; S2 : String := ""; S3 : String := "");
-- Delete all temp files created by Gnatmake and call Osint.Fail,
-- with the parameter S1, S2 and S3 (see osint.ads).
@ -3383,6 +3391,7 @@ package body Make is
Make.Initialize;
Bind_Shared := No_Shared_Switch'Access;
Link_With_Shared_Libgcc := No_Shared_Libgcc_Switch'Access;
Bind_Shared_Known := False;
Failed_Links.Set_Last (0);
@ -4769,6 +4778,12 @@ package body Make is
Projects.Table (Proj).Library_Kind /= Static
then
Bind_Shared := Shared_Switch'Access;
if GCC_Version >= 3 then
Link_With_Shared_Libgcc :=
Shared_Libgcc_Switch'Access;
end if;
exit;
end if;
end loop;
@ -5276,7 +5291,9 @@ package body Make is
-- And invoke the linker
begin
Link (Main_ALI_File, Args (Args'First .. Last_Arg));
Link (Main_ALI_File,
Link_With_Shared_Libgcc.all &
Args (Args'First .. Last_Arg));
Successful_Links.Increment_Last;
Successful_Links.Table (Successful_Links.Last) :=
Main_ALI_File;

11
gcc/ada/opt.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2003, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2004, 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- --
@ -444,6 +444,15 @@ package Opt is
-- GNAT
-- Set True to generate full source listing with embedded errors
function get_gcc_version return Int;
pragma Import (C, get_gcc_version, "get_gcc_version");
GCC_Version : constant Nat := get_gcc_version;
-- GNATMAKE
-- Indicates which version of gcc is in use (2 = 2.8.1, 3 = 3.x).
-- Used in particular to decide if gcc switch -shared-libgcc should be
-- used (it cannot be used for 2.8.1).
Global_Discard_Names : Boolean := False;
-- GNAT, GNATBIND
-- Set true if a pragma Discard_Names applies to the current unit

2
gcc/ada/s-interr.adb
View File

@ -1249,7 +1249,7 @@ package body System.Interrupts is
task body Server_Task is
Intwait_Mask : aliased IMNG.Interrupt_Mask;
Ret_Interrupt : Interrupt_ID;
Self_ID : Task_ID := Self;
Self_ID : constant Task_ID := Self;
Tmp_Handler : Parameterless_Handler;
Tmp_ID : Task_ID;
Tmp_Entry_Index : Task_Entry_Index;

2
gcc/ada/s-stache.adb
View File

@ -214,7 +214,7 @@ package body System.Stack_Checking is
Full_Check :
declare
My_Stack : Stack_Access := Set_Stack_Info (Cache'Access);
My_Stack : constant Stack_Access := Set_Stack_Info (Cache'Access);
-- At this point Stack.all might already be invalid, so
-- it is essential to use our local copy of Stack!

2
gcc/ada/s-taenca.adb
View File

@ -262,7 +262,7 @@ package body System.Tasking.Entry_Calls is
if Ceiling_Violation then
declare
Current_Task : Task_ID := STPO.Self;
Current_Task : constant Task_ID := STPO.Self;
Old_Base_Priority : System.Any_Priority;
begin

12
gcc/ada/sem_dist.adb
View File

@ -441,8 +441,7 @@ package body Sem_Dist is
Make_Component_Definition (Loc,
Aliased_Present => False,
Subtype_Indication =>
New_Reference_To
(Standard_Integer, Loc))),
New_Reference_To (Standard_Integer, Loc))),
Make_Component_Declaration (Loc,
Defining_Identifier =>
@ -452,8 +451,7 @@ package body Sem_Dist is
Make_Component_Definition (Loc,
Aliased_Present => False,
Subtype_Indication =>
New_Reference_To
(RTE (RE_Unsigned_64), Loc))),
New_Reference_To (RTE (RE_Unsigned_64), Loc))),
Make_Component_Declaration (Loc,
Defining_Identifier =>
@ -463,8 +461,7 @@ package body Sem_Dist is
Make_Component_Definition (Loc,
Aliased_Present => False,
Subtype_Indication =>
New_Reference_To
(Standard_Natural, Loc))),
New_Reference_To (Standard_Natural, Loc))),
Make_Component_Declaration (Loc,
Defining_Identifier =>
@ -474,8 +471,7 @@ package body Sem_Dist is
Make_Component_Definition (Loc,
Aliased_Present => False,
Subtype_Indication =>
New_Reference_To
(Standard_Boolean, Loc)))))));
New_Reference_To (Standard_Boolean, Loc)))))));
Insert_After (N, New_Type_Decl);
Set_Equivalent_Type (User_Type, Fat_Type);

10
gcc/ada/sem_res.adb
View File

@ -408,9 +408,10 @@ package body Sem_Res is
and then Scope (Disc) = Current_Scope
and then not
(Nkind (Parent (P)) = N_Subtype_Indication
and then
(Nkind (Parent (Parent (P))) = N_Component_Definition
or else Nkind (Parent (Parent (P))) = N_Subtype_Declaration)
and then
(Nkind (Parent (Parent (P))) = N_Component_Definition
or else
Nkind (Parent (Parent (P))) = N_Subtype_Declaration)
and then Paren_Count (N) = 0)
then
Error_Msg_N
@ -419,8 +420,9 @@ package body Sem_Res is
end if;
-- Detect a common beginner error:
-- type R (D : Positive := 100) is record
-- Name: String (1 .. D);
-- Name : String (1 .. D);
-- end record;
-- The default value causes an object of type R to be

2
gcc/ada/sem_util.adb
View File

@ -3221,7 +3221,7 @@ package body Sem_Util is
function Has_Dependent_Constraint (Comp : Entity_Id) return Boolean is
Comp_Decl : constant Node_Id := Parent (Comp);
Subt_Indic : constant Node_Id :=
Subtype_Indication (Component_Definition (Comp_Decl));
Subtype_Indication (Component_Definition (Comp_Decl));
Constr : Node_Id;
Assn : Node_Id;

2
gcc/ada/sprint.adb
View File

@ -951,9 +951,11 @@ package body Sprint is
when N_Component_Definition =>
Set_Debug_Sloc;
if Aliased_Present (Node) then
Write_Str_With_Col_Check ("aliased ");
end if;
Sprint_Node (Subtype_Indication (Node));
when N_Component_Declaration =>