Commit 4e0079cc by Arnaud Charlet

[multiple changes]

2009-04-16  Thomas Quinot  <quinot@adacore.com>

	* snames.ads-tmpl (Name_Defined): New predefined name for use by the
	integrated preprocessor.

	* prep.ads, prep.adb (Setup_Hooks): New subprogram.
	(Initialize): Split into two subprograms, Initialize (to be called
	prior to compiler command line processing) and Setup_Hooks (to be called
	later on when the first source file is loaded).

	* gprep.adb: Change call to Prep.Initialize to call to Prep.Setup_Hooks.
	Add call to Prep.Initialize.

	* sinput-l.adb, prepcomp.adb: Change call to Prep.Initialize to call
	to Prep.Setup_Hooks.

2009-04-16  Pascal Obry  <obry@adacore.com>

	* adaint.h, adaint.c (__gnat_chdir): New routine.
	Simple wrapper routines used to convert to proper encoding on
	Windows.

	* s-crtl.ads: Use __gnat_chdir instead of direct call to the C library.

	* a-direct.adb, g-dirope.adb: Use chdir from System.CRTL.

From-SVN: r146174
parent 9093359a
2009-04-16 Thomas Quinot <quinot@adacore.com>
* snames.ads-tmpl (Name_Defined): New predefined name for use by the
integrated preprocessor.
* prep.ads, prep.adb (Setup_Hooks): New subprogram.
(Initialize): Split into two subprograms, Initialize (to be called
prior to compiler command line processing) and Setup_Hooks (to be called
later on when the first source file is loaded).
* gprep.adb: Change call to Prep.Initialize to call to Prep.Setup_Hooks.
Add call to Prep.Initialize.
* sinput-l.adb, prepcomp.adb: Change call to Prep.Initialize to call
to Prep.Setup_Hooks.
2009-04-16 Pascal Obry <obry@adacore.com>
* adaint.h, adaint.c (__gnat_chdir): New routine.
Simple wrapper routines used to convert to proper encoding on
Windows.
* s-crtl.ads: Use __gnat_chdir instead of direct call to the C library.
* a-direct.adb, g-dirope.adb: Use chdir from System.CRTL.
2009-04-16 Quentin Ochem <ochem@adacore.com> 2009-04-16 Quentin Ochem <ochem@adacore.com>
* sinput-p.adb (Clear_Source_File_Table): Use Sinput.Initialize instead * sinput-p.adb (Clear_Source_File_Table): Use Sinput.Initialize instead
...@@ -1044,10 +1044,6 @@ package body Ada.Directories is ...@@ -1044,10 +1044,6 @@ package body Ada.Directories is
procedure Set_Directory (Directory : String) is procedure Set_Directory (Directory : String) is
C_Dir_Name : constant String := Directory & ASCII.NUL; C_Dir_Name : constant String := Directory & ASCII.NUL;
function chdir (Dir_Name : String) return Integer;
pragma Import (C, chdir, "chdir");
begin begin
if not Is_Valid_Path_Name (Directory) then if not Is_Valid_Path_Name (Directory) then
raise Name_Error with raise Name_Error with
......
...@@ -708,6 +708,23 @@ __gnat_rename (char *from, char *to) ...@@ -708,6 +708,23 @@ __gnat_rename (char *from, char *to)
#endif #endif
} }
/* Changing directory. */
int
__gnat_chdir (char *path)
{
#if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (CROSS_COMPILE)
{
TCHAR wpath[GNAT_MAX_PATH_LEN];
S2WSU (wpath, path, GNAT_MAX_PATH_LEN);
return _tchdir (wpath);
}
#else
return chdir (path);
#endif
}
FILE * FILE *
__gnat_fopen (char *path, char *mode, int encoding ATTRIBUTE_UNUSED) __gnat_fopen (char *path, char *mode, int encoding ATTRIBUTE_UNUSED)
{ {
......
...@@ -72,6 +72,7 @@ extern int __gnat_stat (char *, ...@@ -72,6 +72,7 @@ extern int __gnat_stat (char *,
struct stat *); struct stat *);
extern int __gnat_unlink (char *); extern int __gnat_unlink (char *);
extern int __gnat_rename (char *, char *); extern int __gnat_rename (char *, char *);
extern int __gnat_chdir (char *);
extern FILE *__gnat_fopen (char *, char *, int); extern FILE *__gnat_fopen (char *, char *, int);
extern FILE *__gnat_freopen (char *, char *, FILE *, extern FILE *__gnat_freopen (char *, char *, FILE *,
......
...@@ -42,6 +42,7 @@ with Nlists; use Nlists; ...@@ -42,6 +42,7 @@ with Nlists; use Nlists;
with Opt; use Opt; with Opt; use Opt;
with Osint; with Osint;
with Par; with Par;
with Prep;
with Prepcomp; with Prepcomp;
with Restrict; use Restrict; with Restrict; use Restrict;
with Rident; use Rident; with Rident; use Rident;
...@@ -84,6 +85,7 @@ begin ...@@ -84,6 +85,7 @@ begin
Fname.UF.Initialize; Fname.UF.Initialize;
Checks.Initialize; Checks.Initialize;
Sem_Warn.Initialize; Sem_Warn.Initialize;
Prep.Initialize;
-- Create package Standard -- Create package Standard
......
...@@ -168,10 +168,6 @@ package body GNAT.Directory_Operations is ...@@ -168,10 +168,6 @@ package body GNAT.Directory_Operations is
procedure Change_Dir (Dir_Name : Dir_Name_Str) is procedure Change_Dir (Dir_Name : Dir_Name_Str) is
C_Dir_Name : constant String := Dir_Name & ASCII.NUL; C_Dir_Name : constant String := Dir_Name & ASCII.NUL;
function chdir (Dir_Name : String) return Integer;
pragma Import (C, chdir, "chdir");
begin begin
if chdir (C_Dir_Name) /= 0 then if chdir (C_Dir_Name) /= 0 then
raise Directory_Error; raise Directory_Error;
......
...@@ -167,10 +167,11 @@ package body GPrep is ...@@ -167,10 +167,11 @@ package body GPrep is
Namet.Initialize; Namet.Initialize;
Snames.Initialize; Snames.Initialize;
Stringt.Initialize; Stringt.Initialize;
Prep.Initialize;
-- Initialize the preprocessor -- Initialize the preprocessor
Prep.Initialize Prep.Setup_Hooks
(Error_Msg => Errutil.Error_Msg'Access, (Error_Msg => Errutil.Error_Msg'Access,
Scan => Scanner.Scan'Access, Scan => Scanner.Scan'Access,
Set_Ignore_Errors => Errutil.Set_Ignore_Errors'Access, Set_Ignore_Errors => Errutil.Set_Ignore_Errors'Access,
......
...@@ -119,9 +119,6 @@ package body Prep is ...@@ -119,9 +119,6 @@ package body Prep is
String_False : String_Id; String_False : String_Id;
-- "false", as a string_id -- "false", as a string_id
Name_Defined : Name_Id;
-- defined, as a name_id
--------------- ---------------
-- Behaviour -- -- Behaviour --
--------------- ---------------
...@@ -691,13 +688,7 @@ package body Prep is ...@@ -691,13 +688,7 @@ package body Prep is
-- Initialize -- -- Initialize --
---------------- ----------------
procedure Initialize procedure Initialize is
(Error_Msg : Error_Msg_Proc;
Scan : Scan_Proc;
Set_Ignore_Errors : Set_Ignore_Errors_Proc;
Put_Char : Put_Char_Proc;
New_EOL : New_EOL_Proc)
is
begin begin
if not Already_Initialized then if not Already_Initialized then
Start_String; Start_String;
...@@ -707,22 +698,12 @@ package body Prep is ...@@ -707,22 +698,12 @@ package body Prep is
Start_String; Start_String;
Empty_String := End_String; Empty_String := End_String;
Name_Len := 7;
Name_Buffer (1 .. Name_Len) := "defined";
Name_Defined := Name_Find;
Start_String; Start_String;
Store_String_Chars ("False"); Store_String_Chars ("False");
String_False := End_String; String_False := End_String;
Already_Initialized := True; Already_Initialized := True;
end if; end if;
Prep.Error_Msg := Error_Msg;
Prep.Scan := Scan;
Prep.Set_Ignore_Errors := Set_Ignore_Errors;
Prep.Put_Char := Put_Char;
Prep.New_EOL := New_EOL;
end Initialize; end Initialize;
------------------ ------------------
...@@ -1470,4 +1451,25 @@ package body Prep is ...@@ -1470,4 +1451,25 @@ package body Prep is
Source_Modified := No_Error_Found and Modified; Source_Modified := No_Error_Found and Modified;
end Preprocess; end Preprocess;
-----------------
-- Setup_Hooks --
-----------------
procedure Setup_Hooks
(Error_Msg : Error_Msg_Proc;
Scan : Scan_Proc;
Set_Ignore_Errors : Set_Ignore_Errors_Proc;
Put_Char : Put_Char_Proc;
New_EOL : New_EOL_Proc)
is
begin
pragma Assert (Already_Initialized);
Prep.Error_Msg := Error_Msg;
Prep.Scan := Scan;
Prep.Set_Ignore_Errors := Set_Ignore_Errors;
Prep.Put_Char := Put_Char;
Prep.New_EOL := New_EOL;
end Setup_Hooks;
end Prep; end Prep;
...@@ -95,12 +95,16 @@ package Prep is ...@@ -95,12 +95,16 @@ package Prep is
type New_EOL_Proc is access procedure; type New_EOL_Proc is access procedure;
procedure Initialize procedure Initialize;
-- Initialize the preprocessor's global structures
procedure Setup_Hooks
(Error_Msg : Error_Msg_Proc; (Error_Msg : Error_Msg_Proc;
Scan : Scan_Proc; Scan : Scan_Proc;
Set_Ignore_Errors : Set_Ignore_Errors_Proc; Set_Ignore_Errors : Set_Ignore_Errors_Proc;
Put_Char : Put_Char_Proc; Put_Char : Put_Char_Proc;
New_EOL : New_EOL_Proc); New_EOL : New_EOL_Proc);
-- Set the i/o hooks used by the preprocessor
procedure Parse_Def_File; procedure Parse_Def_File;
-- Parse the definition file. The definition file must have already been -- Parse the definition file. The definition file must have already been
......
...@@ -662,7 +662,7 @@ package body Prepcomp is ...@@ -662,7 +662,7 @@ package body Prepcomp is
-- Initialize the preprocessor and set the characteristics of the -- Initialize the preprocessor and set the characteristics of the
-- scanner for a definition file. -- scanner for a definition file.
Prep.Initialize Prep.Setup_Hooks
(Error_Msg => Errout.Error_Msg'Access, (Error_Msg => Errout.Error_Msg'Access,
Scan => Scn.Scanner.Scan'Access, Scan => Scn.Scanner.Scan'Access,
Set_Ignore_Errors => Errout.Set_Ignore_Errors'Access, Set_Ignore_Errors => Errout.Set_Ignore_Errors'Access,
......
...@@ -167,6 +167,9 @@ package System.CRTL is ...@@ -167,6 +167,9 @@ package System.CRTL is
procedure rmdir (dir_name : String); procedure rmdir (dir_name : String);
pragma Import (C, rmdir, "rmdir"); pragma Import (C, rmdir, "rmdir");
function chdir (dir_name : String) return int;
pragma Import (C, chdir, "__gnat_chdir");
function setvbuf function setvbuf
(stream : FILEs; (stream : FILEs;
buffer : chars; buffer : chars;
......
...@@ -494,9 +494,9 @@ package body Sinput.L is ...@@ -494,9 +494,9 @@ package body Sinput.L is
Prep_Buffer_Last := 0; Prep_Buffer_Last := 0;
-- Initialize the preprocessor -- Initialize the preprocessor hooks
Prep.Initialize Prep.Setup_Hooks
(Error_Msg => Errout.Error_Msg'Access, (Error_Msg => Errout.Error_Msg'Access,
Scan => Scn.Scanner.Scan'Access, Scan => Scn.Scanner.Scan'Access,
Set_Ignore_Errors => Errout.Set_Ignore_Errors'Access, Set_Ignore_Errors => Errout.Set_Ignore_Errors'Access,
......
...@@ -220,6 +220,10 @@ package Snames is ...@@ -220,6 +220,10 @@ package Snames is
Name_Put_Line : constant Name_Id := N + $; Name_Put_Line : constant Name_Id := N + $;
Name_To : constant Name_Id := N + $; Name_To : constant Name_Id := N + $;
-- Name used by the integrated preprocessor
Name_Defined : constant Name_Id := N + $;
-- Names for packages that are treated specially by the compiler -- Names for packages that are treated specially by the compiler
Name_Exception_Traces : constant Name_Id := N + $; Name_Exception_Traces : constant Name_Id := N + $;
......
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