[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:
parent
0115e4700b
commit
9bc43c535e
22 changed files with 150 additions and 41 deletions
|
@ -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".
|
||||
|
|
|
@ -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;
|
||||
|
||||
|
|
|
@ -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.
|
||||
|
|
|
@ -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;
|
||||
}
|
||||
|
||||
|
|
|
@ -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);
|
||||
|
|
|
@ -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, --
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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:
|
||||
|
|
|
@ -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 (
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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.
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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!
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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);
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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;
|
||||
|
||||
|
|
|
@ -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 =>
|
||||
|
|
Loading…
Add table
Reference in a new issue