Commit f1f9fe30 by Arnaud Charlet

[multiple changes]

2003-11-20  Jerome Guitton  <guitton@act-europe.fr>

	* 5ztiitho.adb: Remove an unreferenced variable.

2003-11-20  Thomas Quinot  <quinot@act-europe.fr>

	* adaint.c: For FreeBSD, use mkstemp.

2003-11-20  Arnaud Charlet  <charlet@act-europe.fr>

	* gnatlbr.adb: Now reference Gnat_Static_Version_String.

2003-11-20  Robert Dewar  <dewar@gnat.com>

	* bld.adb: Remove useless USE of gnatvsn

	* gnatchop.adb: Minor reformatting
	Clean up version handling to be more consistent

	* gnatxref.adb: Minor reformatting

	* gprcmd.adb: Minor reformatting
	Fix output of copyright to be more consistent with other tools

2003-11-20  Vincent Celier  <celier@gnat.com>

	* make.adb (Scan_Make_Args): Do not transmit --RTS= to gnatlink

2003-11-20  Sergey Rybin  <rybin@act-europe.fr>

	* atree.adb (Initialize): Add initializations for global variables
	used in New_Copy_Tree.

	* cstand.adb (Create_Standard): Add call to Initialize_Scanner (with
	Internal_Source_File as the actual).
	Put the set of statements creating Any_Character before the set of
	statements creating Any_Array to have Any_Character fully initialized
	when it is used in creating Any_Array.

	* scn.adb (Initialize_Scanner): Do not set Comes_From_Source ON and do
	not call Scan in case if the actual is Internal_Source_File
	Add 2003 to copyright note.

	* sinput.adb (Source_First, Source_Last, Source_Text): Add code for
	processing Internal_Source_File.

	* types.ads: Add the constant Internal_Source_File representing the
	source buffer for artificial source-code-like strings created within
	the compiler (the definition of Source_File_Index is changed).

From-SVN: r73798
parent d91edf86
...@@ -138,7 +138,7 @@ private ...@@ -138,7 +138,7 @@ private
Support_Long_Shifts : constant Boolean := True; Support_Long_Shifts : constant Boolean := True;
Suppress_Standard_Library : constant Boolean := False; Suppress_Standard_Library : constant Boolean := False;
Use_Ada_Main_Program_Name : constant Boolean := False; Use_Ada_Main_Program_Name : constant Boolean := False;
ZCX_By_Default : constant Boolean := False; ZCX_By_Default : constant Boolean := True;
GCC_ZCX_Support : constant Boolean := True; GCC_ZCX_Support : constant Boolean := True;
Front_End_ZCX_Support : constant Boolean := False; Front_End_ZCX_Support : constant Boolean := False;
......
...@@ -43,7 +43,6 @@ procedure Initialize_Task_Hooks is ...@@ -43,7 +43,6 @@ procedure Initialize_Task_Hooks is
procedure taskCreateHookAdd (createHookFunction : FUNCPTR); procedure taskCreateHookAdd (createHookFunction : FUNCPTR);
pragma Import (C, taskCreateHookAdd, "taskCreateHookAdd"); pragma Import (C, taskCreateHookAdd, "taskCreateHookAdd");
Result : OSI.STATUS;
begin begin
taskCreateHookAdd (Register'Access); taskCreateHookAdd (Register'Access);
end Initialize_Task_Hooks; end Initialize_Task_Hooks;
2003-11-21 Jerome Guitton <guitton@act-europe.fr>
* 5ztiitho.adb: Remove an unreferenced variable.
2003-11-21 Thomas Quinot <quinot@act-europe.fr>
* adaint.c: For FreeBSD, use mkstemp.
2003-11-21 Arnaud Charlet <charlet@act-europe.fr>
* gnatlbr.adb: Now reference Gnat_Static_Version_String.
2003-11-21 Robert Dewar <dewar@gnat.com>
* bld.adb: Remove useless USE of gnatvsn
* gnatchop.adb: Minor reformatting
Clean up version handling to be more consistent
* gnatxref.adb: Minor reformatting
* gprcmd.adb: Minor reformatting
Fix output of copyright to be more consistent with other tools
2003-11-21 Vincent Celier <celier@gnat.com>
* make.adb (Scan_Make_Args): Do not transmit --RTS= to gnatlink
2003-11-21 Sergey Rybin <rybin@act-europe.fr>
* atree.adb (Initialize): Add initializations for global variables
used in New_Copy_Tree.
* cstand.adb (Create_Standard): Add call to Initialize_Scanner (with
Internal_Source_File as the actual).
Put the set of statements creating Any_Character before the set of
statements creating Any_Array to have Any_Character fully initialized
when it is used in creating Any_Array.
* scn.adb (Initialize_Scanner): Do not set Comes_From_Source ON and do
not call Scan in case if the actual is Internal_Source_File
Add 2003 to copyright note.
* sinput.adb (Source_First, Source_Last, Source_Text): Add code for
processing Internal_Source_File.
* types.ads: Add the constant Internal_Source_File representing the
source buffer for artificial source-code-like strings created within
the compiler (the definition of Source_File_Index is changed).
2003-11-20 Arnaud Charlet <charlet@act-europe.fr> 2003-11-20 Arnaud Charlet <charlet@act-europe.fr>
* 35soccon.ads, 45intnam.ads, 55osinte.adb, 55osinte.ads, * 35soccon.ads, 45intnam.ads, 55osinte.adb, 55osinte.ads,
......
...@@ -667,7 +667,7 @@ __gnat_open_new_temp (char *path, int fmode) ...@@ -667,7 +667,7 @@ __gnat_open_new_temp (char *path, int fmode)
strcpy (path, "GNAT-XXXXXX"); strcpy (path, "GNAT-XXXXXX");
#if defined (linux) && !defined (__vxworks) #if (defined (__FreeBSD__) || defined (linux)) && !defined (__vxworks)
return mkstemp (path); return mkstemp (path);
#elif defined (__Lynx__) #elif defined (__Lynx__)
mktemp (path); mktemp (path);
...@@ -742,7 +742,7 @@ __gnat_tmp_name (char *tmp_filename) ...@@ -742,7 +742,7 @@ __gnat_tmp_name (char *tmp_filename)
free (pname); free (pname);
} }
#elif defined (linux) #elif defined (linux) || defined (__FreeBSD__)
#define MAX_SAFE_PATH 1000 #define MAX_SAFE_PATH 1000
char *tmpdir = getenv ("TMPDIR"); char *tmpdir = getenv ("TMPDIR");
......
...@@ -882,6 +882,11 @@ package body Atree is ...@@ -882,6 +882,11 @@ package body Atree is
Dummy := New_Node (N_Error, No_Location); Dummy := New_Node (N_Error, No_Location);
Set_Name1 (Error, Error_Name); Set_Name1 (Error, Error_Name);
Set_Error_Posted (Error, True); Set_Error_Posted (Error, True);
-- Set global variables for New_Copy_Tree:
NCT_Hash_Tables_Used := False;
NCT_Table_Entries := 0;
NCT_Hash_Table_Setup := False;
end Initialize; end Initialize;
-------------------------- --------------------------
......
...@@ -40,7 +40,7 @@ with GNAT.OS_Lib; use GNAT.OS_Lib; ...@@ -40,7 +40,7 @@ with GNAT.OS_Lib; use GNAT.OS_Lib;
with Erroutc; use Erroutc; with Erroutc; use Erroutc;
with Err_Vars; use Err_Vars; with Err_Vars; use Err_Vars;
with Gnatvsn; use Gnatvsn; with Gnatvsn;
with Namet; use Namet; with Namet; use Namet;
with Opt; use Opt; with Opt; use Opt;
with Output; use Output; with Output; use Output;
......
...@@ -38,6 +38,7 @@ with Targparm; use Targparm; ...@@ -38,6 +38,7 @@ with Targparm; use Targparm;
with Tbuild; use Tbuild; with Tbuild; use Tbuild;
with Ttypes; use Ttypes; with Ttypes; use Ttypes;
with Ttypef; use Ttypef; with Ttypef; use Ttypef;
with Scn;
with Sem_Mech; use Sem_Mech; with Sem_Mech; use Sem_Mech;
with Sem_Util; use Sem_Util; with Sem_Util; use Sem_Util;
with Sinfo; use Sinfo; with Sinfo; use Sinfo;
...@@ -259,10 +260,10 @@ package body CStand is ...@@ -259,10 +260,10 @@ package body CStand is
-- by Initialize_Standard in the semantics module. -- by Initialize_Standard in the semantics module.
procedure Create_Standard is procedure Create_Standard is
Decl_S : List_Id; Decl_S : List_Id := New_List;
-- List of declarations in Standard -- List of declarations in Standard
Decl_A : List_Id; Decl_A : List_Id := New_List;
-- List of declarations in ASCII -- List of declarations in ASCII
Decl : Node_Id; Decl : Node_Id;
...@@ -297,7 +298,9 @@ package body CStand is ...@@ -297,7 +298,9 @@ package body CStand is
-- Start of processing for Create_Standard -- Start of processing for Create_Standard
begin begin
Decl_S := New_List; -- Initialize scanner for internal scans of literals
Scn.Initialize_Scanner (No_Unit, Internal_Source_File);
-- First step is to create defining identifiers for each entity -- First step is to create defining identifiers for each entity
...@@ -414,7 +417,6 @@ package body CStand is ...@@ -414,7 +417,6 @@ package body CStand is
declare declare
LIS : Nat; LIS : Nat;
begin begin
if Debug_Flag_M then if Debug_Flag_M then
LIS := 64; LIS := 64;
...@@ -657,7 +659,6 @@ package body CStand is ...@@ -657,7 +659,6 @@ package body CStand is
Set_Defining_Unit_Name (Pspec, Standard_Entity (S_ASCII)); Set_Defining_Unit_Name (Pspec, Standard_Entity (S_ASCII));
Set_Ekind (Standard_Entity (S_ASCII), E_Package); Set_Ekind (Standard_Entity (S_ASCII), E_Package);
Decl_A := New_List; -- for ASCII declarations
Set_Visible_Declarations (Pspec, Decl_A); Set_Visible_Declarations (Pspec, Decl_A);
-- Create control character definitions in package ASCII. Note that -- Create control character definitions in package ASCII. Note that
...@@ -791,6 +792,18 @@ package body CStand is ...@@ -791,6 +792,18 @@ package body CStand is
Set_Prim_Alignment (Any_Access); Set_Prim_Alignment (Any_Access);
Make_Name (Any_Access, "an access type"); Make_Name (Any_Access, "an access type");
Any_Character := New_Standard_Entity;
Set_Ekind (Any_Character, E_Enumeration_Type);
Set_Scope (Any_Character, Standard_Standard);
Set_Etype (Any_Character, Any_Character);
Set_Is_Unsigned_Type (Any_Character);
Set_Is_Character_Type (Any_Character);
Init_Esize (Any_Character, Standard_Character_Size);
Init_RM_Size (Any_Character, 8);
Set_Prim_Alignment (Any_Character);
Set_Scalar_Range (Any_Character, Scalar_Range (Standard_Character));
Make_Name (Any_Character, "a character type");
Any_Array := New_Standard_Entity; Any_Array := New_Standard_Entity;
Set_Ekind (Any_Array, E_String_Type); Set_Ekind (Any_Array, E_String_Type);
Set_Scope (Any_Array, Standard_Standard); Set_Scope (Any_Array, Standard_Standard);
...@@ -810,18 +823,6 @@ package body CStand is ...@@ -810,18 +823,6 @@ package body CStand is
Set_Scalar_Range (Any_Boolean, Scalar_Range (Standard_Boolean)); Set_Scalar_Range (Any_Boolean, Scalar_Range (Standard_Boolean));
Make_Name (Any_Boolean, "a boolean type"); Make_Name (Any_Boolean, "a boolean type");
Any_Character := New_Standard_Entity;
Set_Ekind (Any_Character, E_Enumeration_Type);
Set_Scope (Any_Character, Standard_Standard);
Set_Etype (Any_Character, Any_Character);
Set_Is_Unsigned_Type (Any_Character);
Set_Is_Character_Type (Any_Character);
Init_Esize (Any_Character, Standard_Character_Size);
Init_RM_Size (Any_Character, 8);
Set_Prim_Alignment (Any_Character);
Set_Scalar_Range (Any_Character, Scalar_Range (Standard_Character));
Make_Name (Any_Character, "a character type");
Any_Composite := New_Standard_Entity; Any_Composite := New_Standard_Entity;
Set_Ekind (Any_Composite, E_Array_Type); Set_Ekind (Any_Composite, E_Array_Type);
Set_Scope (Any_Composite, Standard_Standard); Set_Scope (Any_Composite, Standard_Standard);
......
...@@ -37,11 +37,6 @@ with Hostparm; ...@@ -37,11 +37,6 @@ with Hostparm;
procedure Gnatchop is procedure Gnatchop is
Cwrite : constant String :=
"GNATCHOP " &
Gnatvsn.Gnat_Version_String &
" Copyright 1998-2000, Ada Core Technologies Inc.";
Terminate_Program : exception; Terminate_Program : exception;
-- Used to terminate execution immediately -- Used to terminate execution immediately
...@@ -57,9 +52,13 @@ procedure Gnatchop is ...@@ -57,9 +52,13 @@ procedure Gnatchop is
Gnat_Cmd : String_Access; Gnat_Cmd : String_Access;
-- Command to execute the GNAT compiler -- Command to execute the GNAT compiler
Gnat_Args : Argument_List_Access := new Argument_List' Gnat_Args : Argument_List_Access :=
(new String'("-c"), new String'("-x"), new String'("ada"), new Argument_List'
new String'("-gnats"), new String'("-gnatu")); (new String'("-c"),
new String'("-x"),
new String'("ada"),
new String'("-gnats"),
new String'("-gnatu"));
-- Arguments used in Gnat_Cmd call -- Arguments used in Gnat_Cmd call
EOF : constant Character := Character'Val (26); EOF : constant Character := Character'Val (26);
...@@ -1110,6 +1109,7 @@ procedure Gnatchop is ...@@ -1110,6 +1109,7 @@ procedure Gnatchop is
else else
Error_Msg ("-k# requires numeric parameter"); Error_Msg ("-k# requires numeric parameter");
end if; end if;
return False; return False;
end if; end if;
end loop; end loop;
...@@ -1139,7 +1139,15 @@ procedure Gnatchop is ...@@ -1139,7 +1139,15 @@ procedure Gnatchop is
when 'v' => when 'v' =>
Verbose_Mode := True; Verbose_Mode := True;
Put_Line (Standard_Error, Cwrite);
-- Why is following written to standard error. Most other
-- tools write to standard output ???
Put (Standard_Error, "GNATCHOP ");
Put (Standard_Error, Gnatvsn.Gnat_Version_String);
Put_Line
(Standard_Error,
" Copyright 1998-2000, Ada Core Technologies Inc.");
when 'w' => when 'w' =>
Overwrite_Files := True; Overwrite_Files := True;
......
...@@ -50,7 +50,7 @@ with Osint; use Osint; ...@@ -50,7 +50,7 @@ with Osint; use Osint;
with System; with System;
procedure GnatLbr is procedure GnatLbr is
pragma Ident (Gnat_Version_String); pragma Ident (Gnat_Static_Version_String);
type Lib_Mode is (None, Create, Set, Delete); type Lib_Mode is (None, Create, Set, Delete);
Next_Arg : Integer; Next_Arg : Integer;
......
...@@ -38,7 +38,6 @@ with GNAT.Command_Line; use GNAT.Command_Line; ...@@ -38,7 +38,6 @@ with GNAT.Command_Line; use GNAT.Command_Line;
with GNAT.Strings; use GNAT.Strings; with GNAT.Strings; use GNAT.Strings;
procedure Gnatxref is procedure Gnatxref is
Search_Unused : Boolean := False; Search_Unused : Boolean := False;
Local_Symbols : Boolean := True; Local_Symbols : Boolean := True;
Prj_File : File_Name_String; Prj_File : File_Name_String;
...@@ -209,8 +208,6 @@ procedure Gnatxref is ...@@ -209,8 +208,6 @@ procedure Gnatxref is
----------------- -----------------
procedure Write_Usage is procedure Write_Usage is
use Ada.Text_IO;
begin begin
Put_Line ("GNATXREF " & Gnatvsn.Gnat_Version_String Put_Line ("GNATXREF " & Gnatvsn.Gnat_Version_String
& " Copyright 1998-2003, Ada Core Technologies Inc."); & " Copyright 1998-2003, Ada Core Technologies Inc.");
......
...@@ -39,23 +39,22 @@ ...@@ -39,23 +39,22 @@
-- stamp copy file time stamp from file1 to file2 -- stamp copy file time stamp from file1 to file2
-- prefix get the prefix of the GNAT installation -- prefix get the prefix of the GNAT installation
with Gnatvsn;
with Osint; use Osint;
with Namet; use Namet;
with Ada.Characters.Handling; use Ada.Characters.Handling; with Ada.Characters.Handling; use Ada.Characters.Handling;
with Ada.Command_Line; use Ada.Command_Line; with Ada.Command_Line; use Ada.Command_Line;
with Ada.Text_IO; use Ada.Text_IO; with Ada.Text_IO; use Ada.Text_IO;
with GNAT.OS_Lib; use GNAT.OS_Lib; with GNAT.OS_Lib; use GNAT.OS_Lib;
with GNAT.Directory_Operations; use GNAT.Directory_Operations; with GNAT.Directory_Operations; use GNAT.Directory_Operations;
with GNAT.Regpat; use GNAT.Regpat; with GNAT.Regpat; use GNAT.Regpat;
with Gnatvsn;
with Osint; use Osint;
with Namet; use Namet;
procedure Gprcmd is procedure Gprcmd is
-- ??? comments are thin throughout this unit -- ??? comments are thin throughout this unit
Version : constant String :=
"GPRCMD " & Gnatvsn.Gnat_Version_String &
" Copyright 2002-2003, Free Software Fundation, Inc.";
procedure Cat (File : String); procedure Cat (File : String);
-- Print the contents of file on standard output. -- Print the contents of file on standard output.
...@@ -350,7 +349,13 @@ begin ...@@ -350,7 +349,13 @@ begin
begin begin
if Cmd = "-v" then if Cmd = "-v" then
Put_Line (Standard_Error, Version);
-- Should this be on Standard_Error ???
Put (Standard_Error, "GPRCMD ");
Put (Standard_Error, Gnatvsn.Gnat_Version_String);
Put_Line (Standard_Error,
" Copyright 2002-2003, Free Software Fundation, Inc.");
Usage; Usage;
elsif Cmd = "pwd" then elsif Cmd = "pwd" then
......
...@@ -6551,7 +6551,6 @@ package body Make is ...@@ -6551,7 +6551,6 @@ package body Make is
then then
Add_Switch (Argv, Compiler, And_Save => And_Save); Add_Switch (Argv, Compiler, And_Save => And_Save);
Add_Switch (Argv, Binder, And_Save => And_Save); Add_Switch (Argv, Binder, And_Save => And_Save);
Add_Switch (Argv, Linker, And_Save => And_Save);
if Argv'Length <= 6 or else Argv (6) /= '=' then if Argv'Length <= 6 or else Argv (6) /= '=' then
Make_Failed ("missing path for --RTS"); Make_Failed ("missing path for --RTS");
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2002 Free Software Foundation, Inc. -- -- Copyright (C) 1992-2003 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- --
...@@ -264,7 +264,9 @@ package body Scn is ...@@ -264,7 +264,9 @@ package body Scn is
-- Set default for Comes_From_Source. All nodes built now until we -- Set default for Comes_From_Source. All nodes built now until we
-- reenter the analyzer will have Comes_From_Source set to True -- reenter the analyzer will have Comes_From_Source set to True
if Index /= Internal_Source_File then
Set_Comes_From_Source_Default (True); Set_Comes_From_Source_Default (True);
end if;
-- Check license if GNAT type header possibly present -- Check license if GNAT type header possibly present
...@@ -278,7 +280,9 @@ package body Scn is ...@@ -278,7 +280,9 @@ package body Scn is
-- call Scan. Scan initial token (note this initializes Prev_Token, -- call Scan. Scan initial token (note this initializes Prev_Token,
-- Prev_Token_Ptr). -- Prev_Token_Ptr).
if Index /= Internal_Source_File then
Scan; Scan;
end if;
-- Clear flags for reserved words used as indentifiers -- Clear flags for reserved words used as indentifiers
......
...@@ -1110,17 +1110,31 @@ package body Sinput is ...@@ -1110,17 +1110,31 @@ package body Sinput is
function Source_First (S : SFI) return Source_Ptr is function Source_First (S : SFI) return Source_Ptr is
begin begin
if S = Internal_Source_File then
return Internal_Source_Ptr'First;
else
return Source_File.Table (S).Source_First; return Source_File.Table (S).Source_First;
end if;
end Source_First; end Source_First;
function Source_Last (S : SFI) return Source_Ptr is function Source_Last (S : SFI) return Source_Ptr is
begin begin
if S = Internal_Source_File then
return Internal_Source_Ptr'Last;
else
return Source_File.Table (S).Source_Last; return Source_File.Table (S).Source_Last;
end if;
end Source_Last; end Source_Last;
function Source_Text (S : SFI) return Source_Buffer_Ptr is function Source_Text (S : SFI) return Source_Buffer_Ptr is
begin begin
if S = Internal_Source_File then
return Internal_Source_Ptr;
else
return Source_File.Table (S).Source_Text; return Source_File.Table (S).Source_Text;
end if;
end Source_Text; end Source_Text;
function Template (S : SFI) return SFI is function Template (S : SFI) return SFI is
......
...@@ -569,9 +569,14 @@ pragma Preelaborate (Types); ...@@ -569,9 +569,14 @@ pragma Preelaborate (Types);
No_Unit : constant Unit_Number_Type := -1; No_Unit : constant Unit_Number_Type := -1;
-- Special value used to signal no unit -- Special value used to signal no unit
type Source_File_Index is new Nat; type Source_File_Index is new Int range -1 .. Int'Last;
-- Type used to index the source file table (see package Sinput) -- Type used to index the source file table (see package Sinput)
Internal_Source_File : constant Source_File_Index :=
Source_File_Index'First;
-- Value used to indicate the buffer for the source-code-like strings
-- internally created withing the compiler (see package Sinput)
No_Source_File : constant Source_File_Index := 0; No_Source_File : constant Source_File_Index := 0;
-- Value used to indicate no source file present -- Value used to indicate no source file present
......
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