diff options
| author | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2007-04-06 09:19:38 +0000 |
|---|---|---|
| committer | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2007-04-06 09:19:38 +0000 |
| commit | 703844c305585a8b88dd4a74d51f60ecf5c8ad2e (patch) | |
| tree | f5cd92cf0c8355154424935e5aa51a46816033b9 /gcc | |
| parent | db00d7ec391560a89dad3971bd426bfb3da0d209 (diff) | |
| download | gcc-703844c305585a8b88dd4a74d51f60ecf5c8ad2e.tar.gz | |
2007-04-06 Vincent Celier <celier@adacore.com>
* errutil.adb (Initialize): Initialize warnings table, if all warnings
are suppressed, supply an initial dummy entry covering all possible
source locations.
* make.adb (Scan_Make_Arg): Reject options that should start with "--"
and start with only one, such as "-RTS=none".
(Collect_Arguments): Do not check for sources outside of projects.
Do not collect arguments if project is externally built.
(Compile_Sources): Do nothing, not even check if the source is up to
date, if its project is externally built.
(Compile): When compiling a predefined source, add -gnatpg
as the second switch, after -c.
(Compile_Sources): Allow compilation of Annex J renames without -a
(Is_In_Object_Directory): Check if the ALI file is in the object
even if there is no project extension.
(Create_Binder_Mapping_File): Only put a unit in the mapping file for
gnatbind if the ALI file effectively exists.
(Initialize): Add the directory where gnatmake is invoked in front of
the path if it is invoked from a bin directory, even without directory
information, so that the correct GNAT tools will be used when spawned
without directory information.
* makeusg.adb: Change switch -S to -eS
Add lines for new switches -we, -wn and -ws
Add line for new switch -p
* prj-proc.adb (Process): Set Success to False when Warning_Mode is
Treat_As_Error and there are warnings.
* switch-m.ads, switch-m.adb (Normalize_Compiler_Switches): Do not skip
-gnatww Change gnatmake switch -S to -eS
(Scan_Make_Switches): Code reorganisation. Process separately multi
character switches and single character switches.
(Scan_Make_Switches): New Boolean out parameter Success. Set Success to
False when switch is not recognized by gnatmake.
(Scan_Make_Switches): Set Setup_Projects True when -p or
--create-missing-dirs is specified.
* fname.adb (Is_Predefined_File_Name): Return True for annex J
renamings Calendar, Machine_Code, Unchecked_Conversion and
Unchecked_Deallocation only when Renamings_Included is True.
* par.adb: Allow library units Calendar, Machine_Code,
Unchecked_Conversion and Unchecked_Deallocation to be recompiled even
when -gnatg is not specified.
(P_Interface_Type_Definition): Remove the formal Is_Synchronized because
there is no need to generate always a record_definition_node in case
of synchronized interface types.
(SIS_Entry_Active): Initialize global variable to False
(P_Null_Exclusion): For AI-447: Add parameter Allow_Anonymous_In_95 to
indicate cases where AI-447 says "not null" is legal.
* makeutl.ads, makeutil.adb (Executable_Prefix_Path): New function
* makegpr.adb (Check_Compilation_Needed): Take into account dependency
files with with several lines starting with the object fileb name.
(Scan_Arg): Set Setup_Projects True when -p or --create-missing-dirs
is specified.
(Initialize): Add the directory where gprmake is invoked in front of the
path, if it is invoked from a bin directory or with directory
information, so that the correct GNAT tools will be used when invoked
directly.
(Check_Compilation_Needed): Process correctly backslashes on Windows.
* vms_data.ads: Update switches/qualifiers
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@123560 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/errutil.adb | 8 | ||||
| -rw-r--r-- | gcc/ada/fname.adb | 12 | ||||
| -rw-r--r-- | gcc/ada/make.adb | 316 | ||||
| -rw-r--r-- | gcc/ada/makegpr.adb | 353 | ||||
| -rw-r--r-- | gcc/ada/makeusg.adb | 29 | ||||
| -rw-r--r-- | gcc/ada/makeutl.adb | 65 | ||||
| -rw-r--r-- | gcc/ada/makeutl.ads | 7 | ||||
| -rw-r--r-- | gcc/ada/par.adb | 30 | ||||
| -rw-r--r-- | gcc/ada/prj-proc.adb | 11 | ||||
| -rw-r--r-- | gcc/ada/switch-m.adb | 404 | ||||
| -rw-r--r-- | gcc/ada/switch-m.ads | 18 | ||||
| -rw-r--r-- | gcc/ada/vms_data.ads | 292 |
12 files changed, 971 insertions, 574 deletions
diff --git a/gcc/ada/errutil.adb b/gcc/ada/errutil.adb index b70f18d2ce8..25e18c1f032 100644 --- a/gcc/ada/errutil.adb +++ b/gcc/ada/errutil.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1991-2005, Free Software Foundation, Inc. -- +-- Copyright (C) 1991-2006, 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- -- @@ -582,6 +582,12 @@ package body Errutil is -- an initial dummy entry covering all possible source locations. Warnings.Init; + + if Warning_Mode = Suppress then + Warnings.Increment_Last; + Warnings.Table (Warnings.Last).Start := Source_Ptr'First; + Warnings.Table (Warnings.Last).Stop := Source_Ptr'Last; + end if; end Initialize; ------------------------ diff --git a/gcc/ada/fname.adb b/gcc/ada/fname.adb index 85a30d9239f..495d7493e6b 100644 --- a/gcc/ada/fname.adb +++ b/gcc/ada/fname.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2005, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2006, 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- -- @@ -120,22 +120,22 @@ package body Fname is Predef_Names : constant array (1 .. 11) of Str8 := ("ada ", -- Ada - "calendar", -- Calendar "interfac", -- Interfaces "system ", -- System - "machcode", -- Machine_Code - "unchconv", -- Unchecked_Conversion - "unchdeal", -- Unchecked_Deallocation -- Remaining entries are only considered if Renamings_Included true + "calendar", -- Calendar + "machcode", -- Machine_Code + "unchconv", -- Unchecked_Conversion + "unchdeal", -- Unchecked_Deallocation "directio", -- Direct_IO "ioexcept", -- IO_Exceptions "sequenio", -- Sequential_IO "text_io "); -- Text_IO Num_Entries : constant Natural := - 7 + 4 * Boolean'Pos (Renamings_Included); + 3 + 8 * Boolean'Pos (Renamings_Included); begin -- Remove extension (if present) diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index d24cc9f397a..c12cbc503b8 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -1811,21 +1811,16 @@ package body Make is Path => Arguments_Path_Name, In_Tree => Project_Tree); - -- If the source is not a source of a project file, check if - -- this is allowed. + -- If the source is not a source of a project file, add the + -- recorded arguments. Check will be done later if the source + -- need to be compiled that the switch -x has been used. if Arguments_Project = No_Project then - if not External_Unit_Compilation_Allowed then - Make_Failed ("external source (", Source_File_Name, - ") is not part of any project; cannot be " & - "compiled without gnatmake switch -x"); - end if; - - -- If it is allowed, simply add the saved gcc switches - Add_Arguments (The_Saved_Gcc_Switches.all); - else + elsif not Project_Tree.Projects.Table + (Arguments_Project).Externally_Built + then -- We get the project directory for the relative path -- switches and arguments. @@ -2521,8 +2516,10 @@ package body Make is begin if Is_Predefined_File_Name (Fname, False) then if Check_Readonly_Files then + Comp_Args (Comp_Args'First + 2 .. Comp_Last + 1) := + Comp_Args (Comp_Args'First + 1 .. Comp_Last); Comp_Last := Comp_Last + 1; - Comp_Args (Comp_Last) := GNAT_Flag; + Comp_Args (Comp_Args'First + 1) := GNAT_Flag; else Make_Failed @@ -2816,7 +2813,7 @@ package body Make is elsif not Check_Readonly_Files and then Full_Lib_File /= No_File - and then Is_Internal_File_Name (Source_File) + and then Is_Internal_File_Name (Source_File, False) then if Force_Compilations then Fail @@ -2837,49 +2834,60 @@ package body Make is else Arguments_Collected := False; - -- Don't waste any time if we have to recompile anyway + -- Do nothing if project of source is externally built - Obj_Stamp := Empty_Time_Stamp; - Need_To_Compile := Force_Compilations; + Collect_Arguments (Source_File, Source_Index, Args); - if not Force_Compilations then - Read_Only := - Full_Lib_File /= No_File - and then not Check_Readonly_Files - and then Is_Readonly_Library (Full_Lib_File); - Check (Source_File, Source_Index, Args, Lib_File, - Read_Only, ALI, Obj_File, Obj_Stamp); - Need_To_Compile := (ALI = No_ALI_Id); - end if; - - if not Need_To_Compile then + if Arguments_Project = No_Project + or else not Project_Tree.Projects.Table + (Arguments_Project).Externally_Built + then + -- Don't waste any time if we have to recompile anyway + + Obj_Stamp := Empty_Time_Stamp; + Need_To_Compile := Force_Compilations; + + if not Force_Compilations then + Read_Only := + Full_Lib_File /= No_File + and then not Check_Readonly_Files + and then Is_Readonly_Library (Full_Lib_File); + Check (Source_File, Source_Index, Args, Lib_File, + Read_Only, ALI, Obj_File, Obj_Stamp); + Need_To_Compile := (ALI = No_ALI_Id); + end if; - -- The ALI file is up-to-date. Record its Id + if not Need_To_Compile then + -- The ALI file is up-to-date. Record its Id - Record_Good_ALI (ALI); + Record_Good_ALI (ALI); - -- Record the time stamp of the most recent object file - -- as long as no (re)compilations are needed. + -- Record the time stamp of the most recent object + -- file as long as no (re)compilations are needed. - if First_Compiled_File = No_File - and then (Most_Recent_Obj_File = No_File - or else Obj_Stamp > Most_Recent_Obj_Stamp) - then - Most_Recent_Obj_File := Obj_File; - Most_Recent_Obj_Stamp := Obj_Stamp; - end if; + if First_Compiled_File = No_File + and then (Most_Recent_Obj_File = No_File + or else Obj_Stamp > Most_Recent_Obj_Stamp) + then + Most_Recent_Obj_File := Obj_File; + Most_Recent_Obj_Stamp := Obj_Stamp; + end if; - else - -- Do nothing if project of source is externally built + else + -- Check that switch -x has been used if a source + -- outside of project files need to be compiled. - if not Arguments_Collected then - Collect_Arguments (Source_File, Source_Index, Args); - end if; + if Main_Project /= No_Project and then + Arguments_Project = No_Project and then + not External_Unit_Compilation_Allowed + then + Make_Failed ("external source (", + Get_Name_String (Source_File), + ") is not part of any project;" + & " cannot be compiled without" & + " gnatmake switch -x"); + end if; - if Arguments_Project = No_Project - or else not Project_Tree.Projects.Table - (Arguments_Project).Externally_Built - then -- Is this the first file we have to compile? if First_Compiled_File = No_File then @@ -3088,7 +3096,7 @@ package body Make is Debug_Msg ("Skipping marked file:", Sfile); elsif not Check_Readonly_Files - and then Is_Internal_File_Name (Sfile) + and then Is_Internal_File_Name (Sfile, False) then Debug_Msg ("Skipping internal file:", Sfile); @@ -3938,47 +3946,18 @@ package body Make is and then Project_Tree.Projects.Table (ALI_Project).Extended_By = No_Project - and then - Project_Tree.Projects.Table - (ALI_Project).Extends = No_Project + and then + Project_Tree.Projects.Table + (ALI_Project).Extends = No_Project then - -- First line is the unit name - - Get_Name_String (ALI_Unit); - Name_Len := Name_Len + 1; - Name_Buffer (Name_Len) := ASCII.LF; - Bytes := - Write - (Mapping_FD, - Name_Buffer (1)'Address, - Name_Len); - OK := Bytes = Name_Len; - - exit when not OK; - - -- Second line it the ALI file name - - Get_Name_String (ALI_Name); - Name_Len := Name_Len + 1; - Name_Buffer (Name_Len) := ASCII.LF; - Bytes := - Write - (Mapping_FD, - Name_Buffer (1)'Address, - Name_Len); - OK := Bytes = Name_Len; - - exit when not OK; - - -- Third line it the ALI path name, concatenation - -- of either the library directory or the object - -- directory with the ALI file name. + -- First check if the ALI file exists. If it does not, + -- do not put the unit in the mapping file. declare ALI : constant String := Get_Name_String (ALI_Name); PD : Project_Data renames - Project_Tree.Projects.Table (ALI_Project); + Project_Tree.Projects.Table (ALI_Project); begin -- For library projects, use the library directory, @@ -4004,19 +3983,61 @@ package body Make is Name_Len := Name_Len + ALI'Length + 1; Name_Buffer (Name_Len) := ASCII.LF; - Bytes := - Write - (Mapping_FD, - Name_Buffer (1)'Address, - Name_Len); - OK := Bytes = Name_Len; - end; - -- If OK is False, it means we were unable - -- to write a line. No point in continuing - -- with the other units. + declare + ALI_Path_Name : constant String := + Name_Buffer (1 .. Name_Len); - exit when not OK; + begin + if Is_Regular_File + (ALI_Path_Name (1 .. ALI_Path_Name'Last - 1)) + then + + -- First line is the unit name + + Get_Name_String (ALI_Unit); + Name_Len := Name_Len + 1; + Name_Buffer (Name_Len) := ASCII.LF; + Bytes := + Write + (Mapping_FD, + Name_Buffer (1)'Address, + Name_Len); + OK := Bytes = Name_Len; + + exit when not OK; + + -- Second line it the ALI file name + + Get_Name_String (ALI_Name); + Name_Len := Name_Len + 1; + Name_Buffer (Name_Len) := ASCII.LF; + Bytes := + Write + (Mapping_FD, + Name_Buffer (1)'Address, + Name_Len); + OK := Bytes = Name_Len; + + exit when not OK; + + -- Third line it the ALI path name. + + Bytes := + Write + (Mapping_FD, + ALI_Path_Name (1)'Address, + ALI_Path_Name'Length); + OK := Bytes = ALI_Path_Name'Length; + + -- If OK is False, it means we were unable + -- to write a line. No point in continuing + -- with the other units. + + exit when not OK; + end if; + end; + end; end if; end if; end; @@ -6086,34 +6107,45 @@ package body Make is Mains.Delete; -- Add the directory where gnatmake is invoked in front of the - -- path, if gnatmake is invoked with directory information. - -- Only do this if the platform is not VMS, where the notion of path - -- does not really exist. + -- path, if gnatmake is invoked from a bin directory or with directory + -- information. Only do this if the platform is not VMS, where the + -- notion of path does not really exist. if not OpenVMS then declare + Prefix : constant String := Executable_Prefix_Path; Command : constant String := Command_Name; begin - for Index in reverse Command'Range loop - if Command (Index) = Directory_Separator then - declare - Absolute_Dir : constant String := - Normalize_Pathname - (Command (Command'First .. Index)); - - PATH : constant String := - Absolute_Dir & - Path_Separator & - Getenv ("PATH").all; + if Prefix'Length > 0 then + declare + PATH : constant String := + Prefix & Directory_Separator & "bin" & + Path_Separator & + Getenv ("PATH").all; + begin + Setenv ("PATH", PATH); + end; - begin - Setenv ("PATH", PATH); - end; + else + for Index in reverse Command'Range loop + if Command (Index) = Directory_Separator then + declare + Absolute_Dir : constant String := + Normalize_Pathname + (Command (Command'First .. Index)); + PATH : constant String := + Absolute_Dir & + Path_Separator & + Getenv ("PATH").all; + begin + Setenv ("PATH", PATH); + end; - exit; - end if; - end loop; + exit; + end if; + end loop; + end if; end; end if; @@ -6541,13 +6573,7 @@ package body Make is -- in its object directory. If it is not, return False, so that -- the ALI file will not be skipped. - -- If the source is not in an extending project, we fall back to - -- the general case and return True at the end of the function. - - if Project /= No_Project - and then Project_Tree.Projects.Table - (Project).Extends /= No_Project - then + if Project /= No_Project then Data := Project_Tree.Projects.Table (Project); declare @@ -6843,6 +6869,8 @@ package body Make is ------------------- procedure Scan_Make_Arg (Argv : String; And_Save : Boolean) is + Success : Boolean; + begin pragma Assert (Argv'First = 1); @@ -7098,7 +7126,7 @@ package body Make is end if; else - Make_Failed ("unknown switch: ", Argv); + Scan_Make_Switches (Argv, Success); end if; -- If we have seen a regular switch process it @@ -7108,6 +7136,15 @@ package body Make is if Argv'Length = 1 then Make_Failed ("switch character cannot be followed by a blank"); + -- Incorrect switches that should start with "--" + + elsif (Argv'Length > 5 and then Argv (1 .. 5) = "-RTS=") + or else (Argv'Length > 5 and then Argv (1 .. 5) = "-GCC=") + or else (Argv'Length > 10 and then Argv (1 .. 10) = "-GNATLINK=") + or else (Argv'Length > 10 and then Argv (1 .. 10) = "-GNATBIND=") + then + Make_Failed ("option ", Argv, " should start with '--'"); + -- -I- elsif Argv (2 .. Argv'Last) = "I-" then @@ -7206,7 +7243,7 @@ package body Make is "project file"); else - Scan_Make_Switches (Argv); + Scan_Make_Switches (Argv, Success); end if; -- -d @@ -7224,13 +7261,13 @@ package body Make is "project file"); else - Scan_Make_Switches (Argv); + Scan_Make_Switches (Argv, Success); end if; -- -j (need to save the result) elsif Argv (2) = 'j' then - Scan_Make_Switches (Argv); + Scan_Make_Switches (Argv, Success); if And_Save then Saved_Maximum_Processes := Maximum_Processes; @@ -7365,29 +7402,16 @@ package body Make is Add_Switch (Argv, Compiler, And_Save => And_Save); Add_Switch (Argv, Binder, And_Save => And_Save); - -- By default all switches with more than one character or one - -- character switches are passed to the compiler with the - -- exception of those tested below, which belong to make. - - elsif Argv (2) /= 'd' - and then Argv (2) /= 'e' - and then Argv (2 .. Argv'Last) /= "B" - and then Argv (2 .. Argv'Last) /= "C" - and then Argv (2 .. Argv'Last) /= "F" - and then Argv (2 .. Argv'Last) /= "M" - and then Argv (2 .. Argv'Last) /= "R" - and then Argv (2 .. Argv'Last) /= "S" - and then Argv (2 .. Argv'Last) /= "vl" - and then Argv (2 .. Argv'Last) /= "vm" - and then Argv (2 .. Argv'Last) /= "vh" - and then (Argv'Length > 2 or else Argv (2) not in 'a' .. 'z') - then - Add_Switch (Argv, Compiler, And_Save => And_Save); - - -- All other options are handled by Scan_Make_Switches + -- All other switches are processed by Scan_Make_Switches. + -- If the call returns with Success = False, then the switch is + -- passed to the compiler. else - Scan_Make_Switches (Argv); + Scan_Make_Switches (Argv, Success); + + if not Success then + Add_Switch (Argv, Compiler, And_Save => And_Save); + end if; end if; -- If not a switch it must be a file name diff --git a/gcc/ada/makegpr.adb b/gcc/ada/makegpr.adb index ea95216ceda..8ba177a9484 100644 --- a/gcc/ada/makegpr.adb +++ b/gcc/ada/makegpr.adb @@ -31,6 +31,7 @@ with Ada.Unchecked_Deallocation; with Csets; with Gnatvsn; +with Hostparm; use Hostparm; with GNAT.Directory_Operations; use GNAT.Directory_Operations; with GNAT.Dynamic_Tables; @@ -56,6 +57,10 @@ with Types; use Types; package body Makegpr is + On_Windows : constant Boolean := Directory_Separator = '\'; + -- True when on Windows. Used in Check_Compilation_Needed when processing + -- C/C++ dependency files for backslash handling. + Max_In_Archives : constant := 50; -- The maximum number of arguments for a single invocation of the -- Archive Indexer (ar). @@ -1803,6 +1808,9 @@ package body Makegpr is Start : Natural; Finish : Natural; + Looping : Boolean := False; + -- Set to True at the end of the first Big_Loop + begin -- Assume the worst, so that statement "return;" may be used if there -- is any problem. @@ -1881,179 +1889,213 @@ package body Makegpr is return; end if; - declare - End_Of_File_Reached : Boolean := False; + -- Loop Big_Loop is executed several times only when the dependency file + -- contains several times + -- <object file>: <source1> ... + -- When there is only one of such occurence, Big_Loop is exited + -- successfully at the beginning of the second loop. - begin - loop - if End_Of_File (Dep_File) then - End_Of_File_Reached := True; - exit; - end if; + Big_Loop : + loop + declare + End_Of_File_Reached : Boolean := False; - Get_Line (Dep_File, Name_Buffer, Name_Len); + begin + loop + if End_Of_File (Dep_File) then + End_Of_File_Reached := True; + exit; + end if; - exit when Name_Len > 0 and then Name_Buffer (1) /= '#'; - end loop; + Get_Line (Dep_File, Name_Buffer, Name_Len); + + exit when Name_Len > 0 and then Name_Buffer (1) /= '#'; + end loop; - -- If dependency file contains only empty lines or comments, then - -- dependencies are unknown, and the source needs to be recompiled. + -- If dependency file contains only empty lines or comments, then + -- dependencies are unknown, and the source needs to be + -- recompiled. - if End_Of_File_Reached then + if End_Of_File_Reached then + -- If we have reached the end of file after the first loop, + -- there is nothing else to do. + + exit Big_Loop when Looping; + + if Verbose_Mode then + Write_Str (" -> dependency file "); + Write_Str (Dep_Name); + Write_Line (" is empty"); + end if; + + Close (Dep_File); + return; + end if; + end; + + Start := 1; + Finish := Index (Name_Buffer (1 .. Name_Len), ": "); + + -- First line must start with name of object file, followed by colon + + if Finish = 0 or else + Name_Buffer (1 .. Finish - 1) /= Object_Name + then if Verbose_Mode then Write_Str (" -> dependency file "); Write_Str (Dep_Name); - Write_Line (" is empty"); + Write_Line (" has wrong format"); end if; Close (Dep_File); return; - end if; - end; - Start := 1; - Finish := Index (Name_Buffer (1 .. Name_Len), ": "); - - -- First line must start with name of object file, followed by colon - - if Finish = 0 or else Name_Buffer (1 .. Finish - 1) /= Object_Name then - if Verbose_Mode then - Write_Str (" -> dependency file "); - Write_Str (Dep_Name); - Write_Line (" has wrong format"); - end if; - - Close (Dep_File); - return; + else + Start := Finish + 2; - else - Start := Finish + 2; + -- Process each line - -- Process each line + Line_Loop : loop + declare + Line : String := Name_Buffer (1 .. Name_Len); + Last : Natural := Name_Len; - Line_Loop : loop - declare - Line : String := Name_Buffer (1 .. Name_Len); - Last : Natural := Name_Len; + begin + Name_Loop : loop - begin - Name_Loop : loop + -- Find the beginning of the next source path name - -- Find the beginning of the next source path name + while Start < Last and then Line (Start) = ' ' loop + Start := Start + 1; + end loop; - while Start < Last and then Line (Start) = ' ' loop - Start := Start + 1; - end loop; + -- Go to next line when there is a continuation character + -- \ at the end of the line. - -- Go to next line when there is a continuation character \ - -- at the end of the line. + exit Name_Loop when Start = Last + and then Line (Start) = '\'; - exit Name_Loop when Start = Last - and then Line (Start) = '\'; + -- We should not be at the end of the line, without + -- a continuation character \. - -- We should not be at the end of the line, without - -- a continuation character \. + if Start = Last then + if Verbose_Mode then + Write_Str (" -> dependency file "); + Write_Str (Dep_Name); + Write_Line (" has wrong format"); + end if; - if Start = Last then - if Verbose_Mode then - Write_Str (" -> dependency file "); - Write_Str (Dep_Name); - Write_Line (" has wrong format"); + Close (Dep_File); + return; end if; - Close (Dep_File); - return; - end if; - - -- Look for the end of the source path name - - Finish := Start; - while Finish < Last loop - if Line (Finish) = '\' then - - -- When we are getting a '\' that is not the last - -- character of the line, the next character is part - -- of the path name, even if it is a space. + -- Look for the end of the source path name + + Finish := Start; + while Finish < Last loop + if Line (Finish) = '\' then + + -- On Windows, a '\' is part of the path name, + -- except when it is followed by another '\' or by + -- a space. On other platforms, when we are getting + -- a '\' that is not the last character of the + -- line, the next character is part of the path + -- name, even if it is a space. + + if On_Windows and then + Line (Finish + 1) /= '\' and then + Line (Finish + 1) /= ' ' + then + Finish := Finish + 1; + + else + Line (Finish .. Last - 1) := + Line (Finish + 1 .. Last); + Last := Last - 1; + end if; - Line (Finish .. Last - 1) := Line (Finish + 1 .. Last); - Last := Last - 1; + else + -- A space that is not preceded by '\' indicates + -- the end of the path name. - else - -- A space that is not preceded by '\' indicates the - -- end of the path name. + exit when Line (Finish + 1) = ' '; - exit when Line (Finish + 1) = ' '; + Finish := Finish + 1; + end if; + end loop; - Finish := Finish + 1; - end if; - end loop; + -- Check this source - -- Check this source + declare + Src_Name : constant String := + Normalize_Pathname + (Name => + Line (Start .. Finish), + Resolve_Links => False, + Case_Sensitive => False); + Src_TS : Time_Stamp_Type; - declare - Src_Name : constant String := - Normalize_Pathname - (Name => Line (Start .. Finish), - Resolve_Links => False, - Case_Sensitive => False); - Src_TS : Time_Stamp_Type; + begin + -- If it is original source, set + -- Source_In_Dependencies. - begin - -- If it is original source, set Source_In_Dependencies + if Src_Name = Source_Path then + Source_In_Dependencies := True; + end if; - if Src_Name = Source_Path then - Source_In_Dependencies := True; - end if; + Name_Len := 0; + Add_Str_To_Name_Buffer (Src_Name); + Src_TS := File_Stamp (Name_Find); - Name_Len := 0; - Add_Str_To_Name_Buffer (Src_Name); - Src_TS := File_Stamp (Name_Find); + -- If the source does not exist, we need to recompile - -- If the source does not exist, we need to recompile + if Src_TS = Empty_Time_Stamp then + if Verbose_Mode then + Write_Str (" -> source "); + Write_Str (Src_Name); + Write_Line (" does not exist"); + end if; - if Src_TS = Empty_Time_Stamp then - if Verbose_Mode then - Write_Str (" -> source "); - Write_Str (Src_Name); - Write_Line (" does not exist"); - end if; + Close (Dep_File); + return; - Close (Dep_File); - return; + -- If the source has been modified after the object + -- file, we need to recompile. - -- If the source has been modified after the object file, - -- we need to recompile. + elsif Src_TS > Source.Object_TS then + if Verbose_Mode then + Write_Str (" -> source "); + Write_Str (Src_Name); + Write_Line + (" has time stamp later than object file"); + end if; - elsif Src_TS > Source.Object_TS then - if Verbose_Mode then - Write_Str (" -> source "); - Write_Str (Src_Name); - Write_Line - (" has time stamp later than object file"); + Close (Dep_File); + return; end if; + end; - Close (Dep_File); - return; - end if; - end; + -- If the source path name ends the line, we are done - -- If the source path name ends the line, we are done + exit Line_Loop when Finish = Last; - exit Line_Loop when Finish = Last; + -- Go get the next source on the line - -- Go get the next source on the line + Start := Finish + 1; + end loop Name_Loop; + end; - Start := Finish + 1; - end loop Name_Loop; - end; + -- If we are here, we had a continuation character \ at the end + -- of the line, so we continue with the next line. - -- If we are here, we had a continuation character \ at the end - -- of the line, so we continue with the next line. + Get_Line (Dep_File, Name_Buffer, Name_Len); + Start := 1; + end loop Line_Loop; + end if; - Get_Line (Dep_File, Name_Buffer, Name_Len); - Start := 1; - end loop Line_Loop; - end if; + -- Set Looping at the end of the first loop + Looping := True; + end loop Big_Loop; Close (Dep_File); @@ -3271,6 +3313,51 @@ package body Makegpr is Prj.Initialize (Project_Tree); Mains.Delete; + -- Add the directory where gprmake is invoked in front of the path, + -- if gprmake is invoked from a bin directory or with directory + -- information. information. Only do this if the platform is not VMS, + -- where the notion of path does not really exist. + + -- Below code shares nasty code duplication with make.adb code??? + + if not OpenVMS then + declare + Prefix : constant String := Executable_Prefix_Path; + Command : constant String := Command_Name; + + begin + if Prefix'Length > 0 then + declare + PATH : constant String := + Prefix & Directory_Separator & "bin" & + Path_Separator & + Getenv ("PATH").all; + begin + Setenv ("PATH", PATH); + end; + + else + for Index in reverse Command'Range loop + if Command (Index) = Directory_Separator then + declare + Absolute_Dir : constant String := + Normalize_Pathname + (Command (Command'First .. Index)); + PATH : constant String := + Absolute_Dir & + Path_Separator & + Getenv ("PATH").all; + begin + Setenv ("PATH", PATH); + end; + + exit; + end if; + end loop; + end if; + end; + end if; + -- Set Name_Ide and Name_Compiler_Command Name_Len := 0; @@ -4107,6 +4194,9 @@ package body Makegpr is Project_File_Name := new String'(Arg (3 .. Arg'Last)); end if; + elsif Arg = "-p" or else Arg = "--create-missing-dirs" then + Setup_Projects := True; + elsif Arg = "-q" then Quiet_Output := True; @@ -4193,11 +4283,7 @@ package body Makegpr is Write_Str ("Usage: "); Osint.Write_Program_Name; Write_Str (" -P<project file> [opts] [name] {"); - - for Lang in First_Language_Indexes loop - Write_Str ("[-cargs:lang opts] "); - end loop; - + Write_Str ("[-cargs:lang opts] "); Write_Str ("[-largs opts] [-gargs opts]}"); Write_Eol; Write_Eol; @@ -4230,6 +4316,11 @@ package body Makegpr is Write_Str (" -o name Choose an alternate executable name"); Write_Eol; + -- Line for -p + + Write_Str (" -p Create missing obj, lib and exec dirs"); + Write_Eol; + -- Line for -P Write_Str (" -Pproj Use GNAT Project File proj"); diff --git a/gcc/ada/makeusg.adb b/gcc/ada/makeusg.adb index 5dc0604cd3b..027a4cfa473 100644 --- a/gcc/ada/makeusg.adb +++ b/gcc/ada/makeusg.adb @@ -99,6 +99,11 @@ begin "project files"); Write_Eol; + -- Line for -eS + + Write_Str (" -eS Echo commands to stdout instead of stderr"); + Write_Eol; + -- Line for -f Write_Str (" -f Force recompilations of non predefined units"); @@ -151,6 +156,11 @@ begin Write_Str (" -o name Choose an alternate executable name"); Write_Eol; + -- Line for -p + + Write_Str (" -p Create missing obj, lib and exec dirs"); + Write_Eol; + -- Line for -P Write_Str (" -Pproj Use GNAT Project File proj"); @@ -171,10 +181,6 @@ begin Write_Str (" -s Recompile if compiler switches have changed"); Write_Eol; - -- Line for -S - - Write_Str (" -S Echo commands to stdout instead of stderr"); - -- Line for -u Write_Str (" -u Unique compilation, only compile the given files"); @@ -195,6 +201,21 @@ begin Write_Str (" -vPx Specify verbosity when parsing GNAT Project Files"); Write_Eol; + -- Line for -we + + Write_Str (" -we treat all Warnings as Errors"); + Write_Eol; + + -- Line for -wn + + Write_Str (" -wn Normal Warning mode (cancels -we/-ws)"); + Write_Eol; + + -- Line for -ws + + Write_Str (" -ws Suppress all Warnings"); + Write_Eol; + -- Line for -x Write_Str (" -x " & diff --git a/gcc/ada/makeutl.adb b/gcc/ada/makeutl.adb index 4a7a0b9e9ce..a3d3c5bae46 100644 --- a/gcc/ada/makeutl.adb +++ b/gcc/ada/makeutl.adb @@ -24,6 +24,8 @@ -- -- ------------------------------------------------------------------------------ +with Ada.Command_Line; use Ada.Command_Line; + with Namet; use Namet; with Osint; use Osint; with Prj.Ext; @@ -31,6 +33,7 @@ with Prj.Util; with Snames; use Snames; with Table; +with System.Case_Util; use System.Case_Util; with System.HTable; package body Makeutl is @@ -117,6 +120,68 @@ package body Makeutl is Marks.Reset; end Delete_All_Marks; + ---------------------------- + -- Executable_Prefix_Path -- + ---------------------------- + + function Executable_Prefix_Path return String is + Exec_Name : constant String := Command_Name; + + function Get_Install_Dir (S : String) return String; + -- S is the executable name preceeded by the absolute or relative + -- path, e.g. "c:\usr\bin\gcc.exe". Returns the absolute directory + -- where "bin" lies (in the example "C:\usr"). + -- If the executable is not in a "bin" directory, return "". + + --------------------- + -- Get_Install_Dir -- + --------------------- + + function Get_Install_Dir (S : String) return String is + Exec : String := S; + Path_Last : Integer := 0; + + begin + for J in reverse Exec'Range loop + if Exec (J) = Directory_Separator then + Path_Last := J - 1; + exit; + end if; + end loop; + + if Path_Last >= Exec'First + 2 then + To_Lower (Exec (Path_Last - 2 .. Path_Last)); + end if; + + if Path_Last < Exec'First + 2 + or else Exec (Path_Last - 2 .. Path_Last) /= "bin" + or else (Path_Last - 3 >= Exec'First + and then Exec (Path_Last - 3) /= Directory_Separator) + then + return ""; + end if; + + return Normalize_Pathname (Exec (Exec'First .. Path_Last - 4)); + end Get_Install_Dir; + + -- Beginning of Executable_Prefix_Path + + begin + -- First determine if a path prefix was placed in front of the + -- executable name. + + for J in reverse Exec_Name'Range loop + if Exec_Name (J) = Directory_Separator then + return Get_Install_Dir (Exec_Name); + end if; + end loop; + + -- If we get here, the user has typed the executable name with no + -- directory prefix. + + return Get_Install_Dir (Locate_Exec_On_Path (Exec_Name).all); + end Executable_Prefix_Path; + ---------- -- Hash -- ---------- diff --git a/gcc/ada/makeutl.ads b/gcc/ada/makeutl.ads index d69adb2f628..b2a75f770f5 100644 --- a/gcc/ada/makeutl.ads +++ b/gcc/ada/makeutl.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2004-2005 Free Software Foundation, Inc. -- +-- Copyright (C) 2004-2006 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- -- @@ -43,6 +43,11 @@ package Makeutl is -- Find the index of a unit in a source file. Return zero if the file -- is not a multi-unit source file. + function Executable_Prefix_Path return String; + -- Return the absolute path parent directory of the directory where the + -- current executable resides, if its directory is named "bin", otherwise + -- return an empty string. + function Is_External_Assignment (Argv : String) return Boolean; -- Verify that an external assignment switch is syntactically correct -- diff --git a/gcc/ada/par.adb b/gcc/ada/par.adb index fabb9ea724f..bebc66970fd 100644 --- a/gcc/ada/par.adb +++ b/gcc/ada/par.adb @@ -142,7 +142,7 @@ is -- whose body is required and has not yet been found. The prefix SIS -- stands for "Subprogram IS" handling. - SIS_Entry_Active : Boolean; + SIS_Entry_Active : Boolean := False; -- Set True to indicate that an entry is active (i.e. that a subprogram -- declaration has been encountered, and no body for this subprogram has -- been encountered). The remaining fields are valid only if this is True. @@ -605,22 +605,22 @@ is -- declaration of this type for details. function P_Interface_Type_Definition - (Abstract_Present : Boolean; - Is_Synchronized : Boolean) return Node_Id; + (Abstract_Present : Boolean) return Node_Id; -- Ada 2005 (AI-251): Parse the interface type definition part. Abstract -- Present indicates if the reserved word "abstract" has been previously -- found. It is used to report an error message because interface types - -- are by definition abstract tagged. Is_Synchronized is True in case of - -- task interfaces, protected interfaces, and synchronized interfaces; - -- it is used to generate a record_definition node. In the rest of cases - -- (limited interfaces and interfaces) we generate a record_definition + -- are by definition abstract tagged. We generate a record_definition -- node if the list of interfaces is empty; otherwise we generate a -- derived_type_definition node (the first interface in this list is the -- ancestor interface). - function P_Null_Exclusion return Boolean; - -- Ada 2005 (AI-231): Parse the null-excluding part. True indicates - -- that the null-excluding part was present. + function P_Null_Exclusion + (Allow_Anonymous_In_95 : Boolean := False) return Boolean; + -- Ada 2005 (AI-231): Parse the null-excluding part. A True result + -- indicates that the null-excluding part was present. + -- Allow_Anonymous_In_95 is True if we are in a context that allows + -- anonymous access types in Ada 95, in which case "not null" is legal + -- if it precedes "access". function P_Subtype_Indication (Not_Null_Present : Boolean := False) return Node_Id; @@ -1362,13 +1362,9 @@ begin Name := Uname (Uname'First .. Uname'Last - 2); - if Name = "ada" or else - Name = "calendar" or else - Name = "interfaces" or else - Name = "system" or else - Name = "machine_code" or else - Name = "unchecked_conversion" or else - Name = "unchecked_deallocation" + if Name = "ada" or else + Name = "interfaces" or else + Name = "system" then Error_Msg ("language defined units may not be recompiled", diff --git a/gcc/ada/prj-proc.adb b/gcc/ada/prj-proc.adb index 1c382ab5c40..443a3e80e0c 100644 --- a/gcc/ada/prj-proc.adb +++ b/gcc/ada/prj-proc.adb @@ -26,7 +26,7 @@ with Err_Vars; use Err_Vars; with Namet; use Namet; -with Opt; +with Opt; use Opt; with Osint; use Osint; with Output; use Output; with Prj.Attr; use Prj.Attr; @@ -950,7 +950,7 @@ package body Prj.Proc is Value := Prj.Ext.Value_Of (Name, Default); if Value = No_Name then - if not Opt.Quiet_Output then + if not Quiet_Output then if Error_Report = null then Error_Msg ("?undefined external reference", @@ -1268,7 +1268,10 @@ package body Prj.Proc is end loop; end if; - Success := Total_Errors_Detected = 0; + Success := + Total_Errors_Detected = 0 + and then + (Warning_Mode /= Treat_As_Error or else Warnings_Detected = 0); end Process; ------------------------------- @@ -2295,7 +2298,7 @@ package body Prj.Proc is (Imported_Project_List).Next; end loop; - if Opt.Verbose_Mode then + if Verbose_Mode then Write_Str ("Checking project file """); Write_Str (Get_Name_String (Data.Name)); Write_Line (""""); diff --git a/gcc/ada/switch-m.adb b/gcc/ada/switch-m.adb index dc3fe569356..a9239608b0a 100644 --- a/gcc/ada/switch-m.adb +++ b/gcc/ada/switch-m.adb @@ -363,44 +363,40 @@ package body Switch.M is C := Switch_Chars (Ptr); Ptr := Ptr + 1; - -- 'w' should be skipped in -gnatw + -- -gnatyMxxx - if C /= 'w' or else Storing (First_Stored) /= 'w' then - - -- -gnatyMxxx - - if C = 'M' - and then Storing (First_Stored) = 'y' then - Last_Stored := First_Stored + 1; - Storing (Last_Stored) := 'M'; - - while Ptr <= Max loop - C := Switch_Chars (Ptr); - exit when C not in '0' .. '9'; - Last_Stored := Last_Stored + 1; - Storing (Last_Stored) := C; - Ptr := Ptr + 1; - end loop; - - -- If there is no digit after -gnatyM, - -- the switch is invalid. + if C = 'M' and then + Storing (First_Stored) = 'y' + then + Last_Stored := First_Stored + 1; + Storing (Last_Stored) := 'M'; - if Last_Stored = First_Stored + 1 then - Last := 0; - return; + while Ptr <= Max loop + C := Switch_Chars (Ptr); + exit when C not in '0' .. '9'; + Last_Stored := Last_Stored + 1; + Storing (Last_Stored) := C; + Ptr := Ptr + 1; + end loop; - else - Add_Switch_Component - (Storing (Storing'First .. Last_Stored)); - end if; + -- If there is no digit after -gnatyM, + -- the switch is invalid. - -- All other switches are -gnatxx + if Last_Stored = First_Stored + 1 then + Last := 0; + return; else - Storing (First_Stored + 1) := C; Add_Switch_Component - (Storing (Storing'First .. First_Stored + 1)); + (Storing (Storing'First .. Last_Stored)); end if; + + -- All other switches are -gnatxx + + else + Storing (First_Stored + 1) := C; + Add_Switch_Component + (Storing (Storing'First .. First_Stored + 1)); end if; end loop; @@ -481,12 +477,19 @@ package body Switch.M is -- Scan_Make_Switches -- ------------------------ - procedure Scan_Make_Switches (Switch_Chars : String) is + procedure Scan_Make_Switches + (Switch_Chars : String; + Success : out Boolean) + is Ptr : Integer := Switch_Chars'First; Max : constant Integer := Switch_Chars'Last; C : Character := ' '; begin + -- Assume a good switch + + Success := True; + -- Skip past the initial character (must be the switch character) if Ptr = Max then @@ -496,70 +499,42 @@ package body Switch.M is Ptr := Ptr + 1; end if; - -- A little check, "gnat" at the start of a switch is not allowed - -- except for the compiler (where it was already removed) + -- A little check, "gnat" at the start of a switch is for the compiler if Switch_Chars'Length >= Ptr + 3 and then Switch_Chars (Ptr .. Ptr + 3) = "gnat" then - Osint.Fail - ("invalid switch: """, Switch_Chars, """ (gnat not needed here)"); + Success := False; + return; end if; - -- Loop to scan through switches given in switch string - - Check_Switch : begin - C := Switch_Chars (Ptr); - - -- Processing for a switch - - case C is - - when 'a' => - Ptr := Ptr + 1; - Check_Readonly_Files := True; - - -- Processing for b switch - - when 'b' => - Ptr := Ptr + 1; - Bind_Only := True; - Make_Steps := True; - - -- Processing for B switch + C := Switch_Chars (Ptr); - when 'B' => - Ptr := Ptr + 1; - Build_Bind_And_Link_Full_Project := True; - - -- Processing for c switch - - when 'c' => - Ptr := Ptr + 1; - Compile_Only := True; - Make_Steps := True; + -- Multiple character switches - -- Processing for C switch + if Switch_Chars'Length > 2 then + if Switch_Chars = "--create-missing-dirs" then + Setup_Projects := True; - when 'C' => + elsif C = 'v' and then Switch_Chars'Length = 3 then Ptr := Ptr + 1; - Create_Mapping_File := True; - - -- Processing for D switch + Verbose_Mode := True; - when 'D' => - Ptr := Ptr + 1; + case Switch_Chars (Ptr) is + when 'l' => + Verbosity_Level := Opt.Low; - if Object_Directory_Present then - Osint.Fail ("duplicate -D switch"); + when 'm' => + Verbosity_Level := Opt.Medium; - else - Object_Directory_Present := True; - end if; + when 'h' => + Verbosity_Level := Opt.High; - -- Processing for d switch + when others => + Success := False; + end case; - when 'd' => + elsif C = 'd' then -- Note: for the debug switch, the remaining characters in this -- switch field must all be debug flags, since all valid switch @@ -580,17 +555,9 @@ package body Switch.M is end if; end loop; - return; - - -- Processing for e switch - - when 'e' => + elsif C = 'e' then Ptr := Ptr + 1; - if Ptr > Max then - Bad_Switch (Switch_Chars); - end if; - case Switch_Chars (Ptr) is -- Processing for eI switch @@ -599,164 +566,219 @@ package body Switch.M is Ptr := Ptr + 1; Scan_Pos (Switch_Chars, Max, Ptr, Main_Index, C); + if Ptr <= Max then + Bad_Switch (Switch_Chars); + end if; + -- Processing for eL switch when 'L' => - Ptr := Ptr + 1; - Follow_Links := True; + if Ptr /= Max then + Bad_Switch (Switch_Chars); + + else + Follow_Links := True; + end if; + + -- Processing for eS switch + + when 'S' => + if Ptr /= Max then + Bad_Switch (Switch_Chars); + + else + Commands_To_Stdout := True; + end if; when others => Bad_Switch (Switch_Chars); end case; - -- Processing for f switch - - when 'f' => + elsif C = 'j' then Ptr := Ptr + 1; - Force_Compilations := True; - -- Processing for F switch + declare + Max_Proc : Pos; + begin + Scan_Pos (Switch_Chars, Max, Ptr, Max_Proc, C); - when 'F' => - Ptr := Ptr + 1; - Full_Path_Name_For_Brief_Errors := True; + if Ptr <= Max then + Bad_Switch (Switch_Chars); - -- Processing for h switch + else + Maximum_Processes := Positive (Max_Proc); + end if; + end; - when 'h' => + elsif C = 'w' and then Switch_Chars'Length = 3 then Ptr := Ptr + 1; - Usage_Requested := True; - -- Processing for i switch + if Switch_Chars = "-we" then + Warning_Mode := Treat_As_Error; - when 'i' => - Ptr := Ptr + 1; - In_Place_Mode := True; + elsif Switch_Chars = "-wn" then + Warning_Mode := Normal; - -- Processing for j switch + elsif Switch_Chars = "-ws" then + Warning_Mode := Suppress; - when 'j' => - if Ptr = Max then - Bad_Switch (Switch_Chars); + else + Success := False; end if; - Ptr := Ptr + 1; + else + Success := False; + end if; - declare - Max_Proc : Pos; - begin - Scan_Pos (Switch_Chars, Max, Ptr, Max_Proc, C); - Maximum_Processes := Positive (Max_Proc); - end; + -- Single-character switches - -- Processing for k switch + else + Check_Switch : begin - when 'k' => - Ptr := Ptr + 1; - Keep_Going := True; + case C is - -- Processing for l switch + when 'a' => + Check_Readonly_Files := True; - when 'l' => - Ptr := Ptr + 1; - Link_Only := True; - Make_Steps := True; + -- Processing for b switch - when 'M' => - Ptr := Ptr + 1; - List_Dependencies := True; + when 'b' => + Bind_Only := True; + Make_Steps := True; - -- Processing for n switch + -- Processing for B switch - when 'n' => - Ptr := Ptr + 1; - Do_Not_Execute := True; + when 'B' => + Build_Bind_And_Link_Full_Project := True; - -- Processing for o switch + -- Processing for c switch - when 'o' => - Ptr := Ptr + 1; + when 'c' => + Compile_Only := True; + Make_Steps := True; - if Output_File_Name_Present then - Osint.Fail ("duplicate -o switch"); - else - Output_File_Name_Present := True; - end if; + -- Processing for C switch - -- Processing for q switch + when 'C' => + Create_Mapping_File := True; - when 'q' => - Ptr := Ptr + 1; - Quiet_Output := True; + -- Processing for D switch - -- Processing for R switch + when 'D' => + if Object_Directory_Present then + Osint.Fail ("duplicate -D switch"); - when 'R' => - Ptr := Ptr + 1; - Run_Path_Option := False; + else + Object_Directory_Present := True; + end if; - -- Processing for s switch + -- Processing for f switch - when 's' => - Ptr := Ptr + 1; - Check_Switches := True; + when 'f' => + Force_Compilations := True; - -- Processing for S switch + -- Processing for F switch - when 'S' => - Ptr := Ptr + 1; - Commands_To_Stdout := True; + when 'F' => + Full_Path_Name_For_Brief_Errors := True; - -- Processing for v switch + -- Processing for h switch - when 'v' => - Ptr := Ptr + 1; - Verbose_Mode := True; - Verbosity_Level := Opt.High; + when 'h' => + Usage_Requested := True; - if Ptr <= Max then - case Switch_Chars (Ptr) is - when 'l' => - Verbosity_Level := Opt.Low; + -- Processing for i switch - when 'm' => - Verbosity_Level := Opt.Medium; + when 'i' => + In_Place_Mode := True; - when 'h' => - Verbosity_Level := Opt.High; + -- Processing for j switch - when others => - Bad_Switch (Switch_Chars); - end case; + when 'j' => + -- -j not followed by a number is an error - Ptr := Ptr + 1; - end if; + Bad_Switch (Switch_Chars); - -- Processing for x switch + -- Processing for k switch - when 'x' => - Ptr := Ptr + 1; - External_Unit_Compilation_Allowed := True; + when 'k' => + Keep_Going := True; - -- Processing for z switch + -- Processing for l switch - when 'z' => - Ptr := Ptr + 1; - No_Main_Subprogram := True; + when 'l' => + Link_Only := True; + Make_Steps := True; - -- Anything else is an error (illegal switch character) + -- Processing for M switch - when others => - Bad_Switch (Switch_Chars); + when 'M' => + List_Dependencies := True; - end case; + -- Processing for n switch - if Ptr <= Max then - Bad_Switch (Switch_Chars); - end if; + when 'n' => + Do_Not_Execute := True; + + -- Processing for o switch + + when 'o' => + if Output_File_Name_Present then + Osint.Fail ("duplicate -o switch"); + else + Output_File_Name_Present := True; + end if; + + -- Processing for p switch + + when 'p' => + Setup_Projects := True; + + -- Processing for q switch + + when 'q' => + Quiet_Output := True; + + -- Processing for R switch + + when 'R' => + Run_Path_Option := False; - end Check_Switch; + -- Processing for s switch + when 's' => + Ptr := Ptr + 1; + Check_Switches := True; + + -- Processing for v switch + + when 'v' => + Verbose_Mode := True; + Verbosity_Level := Opt.High; + + -- Processing for x switch + + when 'x' => + External_Unit_Compilation_Allowed := True; + + -- Processing for z switch + + when 'z' => + No_Main_Subprogram := True; + + -- Any other small letter is an illegal switch + + when others => + if C in 'a' .. 'z' then + Bad_Switch (Switch_Chars); + + else + Success := False; + end if; + + end case; + end Check_Switch; + end if; end Scan_Make_Switches; end Switch.M; diff --git a/gcc/ada/switch-m.ads b/gcc/ada/switch-m.ads index 5b4a9e6e267..fc073a00e02 100644 --- a/gcc/ada/switch-m.ads +++ b/gcc/ada/switch-m.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2001 Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2006, 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- -- @@ -34,14 +34,14 @@ with GNAT.OS_Lib; use GNAT.OS_Lib; package Switch.M is - procedure Scan_Make_Switches (Switch_Chars : String); - -- Procedures to scan out binder switches stored in the given string. - -- The first character is known to be a valid switch character, and there - -- are no blanks or other switch terminator characters in the string, so - -- the entire string should consist of valid switch characters, except that - -- an optional terminating NUL character is allowed. A bad switch causes - -- a fatal error exit and control does not return. The call also sets - -- Usage_Requested to True if a ? switch is encountered. + procedure Scan_Make_Switches + (Switch_Chars : String; + Success : out Boolean); + -- Scan a gnatmake switch and act accordingly. For switches that are + -- recognized, Success is set to True. A switch that is not recognized and + -- consists of one small letter causes a fatal error exit and control does + -- not return. For all other not recognized switches, Success is set to + -- False, so that the switch may be passed to the compiler. procedure Normalize_Compiler_Switches (Switch_Chars : String; diff --git a/gcc/ada/vms_data.ads b/gcc/ada/vms_data.ads index e7e19efba1e..9aa3939a884 100644 --- a/gcc/ada/vms_data.ads +++ b/gcc/ada/vms_data.ads @@ -1961,6 +1961,8 @@ package VMS_Data is "-gnaty9 " & "ATTRIBUTE " & "-gnatya " & + "ARRAY_INDEXES " & + "-gnatyA " & "BLANKS " & "-gnatyb " & "COMMENTS " & @@ -2030,6 +2032,12 @@ package VMS_Data is -- underscore must be uppercase. -- All other letters must be lowercase. -- + -- ARRAY_INDEXES Check indexes of array attributes. + -- For array attributes First, Last, Range, + -- or Length, the index number must be omitted + -- for one-dimensional arrays and is required + -- for multi-dimensional arrays. + -- -- BLANKS Blanks not allowed at statement end. -- Trailing blanks are not allowed at the end of -- statements. The purpose of this rule, together @@ -4101,6 +4109,14 @@ package VMS_Data is -- when the only modifications to a source file consist in -- adding/removing comments, empty lines, spaces or tabs. + S_Make_Missing : aliased constant S := "/CREATE_MISSING_DIRS " & + "-p"; + -- /NOCREATE_MISSING_DIRS (D) + -- /CREATE_MISSING_DIRS + -- + -- When an object directory, a library directory or an exec directory + -- in missing, attempt to create the directory. + S_Make_Nolink : aliased constant S := "/NOLINK " & "-c"; -- /NOLINK @@ -4212,7 +4228,7 @@ package VMS_Data is -- When looking for source files also look in the specified directories. S_Make_Stand : aliased constant S := "/STANDARD_OUTPUT_FOR_COMMANDS " & - "-S"; + "-eS"; -- /NOSTANDARD_OUTPUT_FOR_COMMANDS (D) -- /STANDARD_OUTPUT_FOR_COMMANDS -- @@ -4286,6 +4302,7 @@ package VMS_Data is S_Make_Med_Verb'Access, S_Make_Mess 'Access, S_Make_Minimal 'Access, + S_Make_Missing 'Access, S_Make_Nolink 'Access, S_Make_Nomain 'Access, S_Make_Nonpro 'Access, @@ -4993,6 +5010,36 @@ package VMS_Data is -- used in the default dictionary file, are defined in the GNAT User's -- Guide. + S_Pretty_Encoding : aliased constant S := "/RESULT_ENCODING=" & + "BRACKETS " & + "-Wb " & + "HEX_ESC " & + "-Wh " & + "UPPER_HALF " & + "-Wu " & + "SHIFT_JIS " & + "-Ws " & + "EUC " & + "-We " & + "UTF_8 " & + "-W8"; + -- /RESULT_ENCODING[=encoding-option] + -- + -- Specify the wide character encoding of the result file. + -- '=encoding-option' may be one of: + -- + -- BRACKETS (D) Brackets encoding. + -- + -- HEX_ESC Hex ESC encoding. + -- + -- UPPER_HALF Upper half encoding. + -- + -- SHIFT_JIS Shift-JIS encoding. + -- + -- EUC EUC Encoding. + -- + -- UTF_8 UTF-8 encoding. + S_Pretty_Files : aliased constant S := "/FILES=@" & "-files=@"; -- /FILES=filename @@ -5225,6 +5272,7 @@ package VMS_Data is S_Pretty_Dico 'Access, S_Pretty_Eol 'Access, S_Pretty_Ext 'Access, + S_Pretty_Encoding 'Access, S_Pretty_Files 'Access, S_Pretty_Forced 'Access, S_Pretty_Formfeed 'Access, @@ -5249,69 +5297,6 @@ package VMS_Data is S_Pretty_Verbose 'Access, S_Pretty_Warnings 'Access); - ----------------------------- - -- Switches for GNAT SETUP -- - ----------------------------- - - S_Setup_Ext : aliased constant S := "/EXTERNAL_REFERENCE=" & '"' & - "-X" & '"'; - -- /EXTERNAL_REFERENCE="name=val" - -- - -- Specifies an external reference to the project manager. Useful only if - -- /PROJECT_FILE is used. - -- - -- Example: - -- /EXTERNAL_REFERENCE="DEBUG=TRUE" - - S_Setup_Mess : aliased constant S := "/MESSAGES_PROJECT_FILE=" & - "DEFAULT " & - "-vP0 " & - "MEDIUM " & - "-vP1 " & - "HIGH " & - "-vP2"; - -- /MESSAGES_PROJECT_FILE[=messages-option] - -- - -- Specifies the "verbosity" of the parsing of project files. - -- messages-option may be one of the following: - -- - -- DEFAULT (D) No messages are output if there is no error or warning. - -- - -- MEDIUM A small number of messages are output. - -- - -- HIGH A great number of messages are output, most of them not - -- being useful for the user. - - S_Setup_Project : aliased constant S := "/PROJECT_FILE=<" & - "-P>"; - -- /PROJECT_FILE=filename - -- - -- Specifies the main project file to be used. The project files rooted - -- at the main project file are parsed and non existing object - -- directories, library directories and exec directories are created. - - S_Setup_Quiet : aliased constant S := "/QUIET " & - "-q"; - -- /NOQUIET (D) - -- /QUIET - -- - -- Work quietly, only output warnings and errors. - - S_Setup_Verbose : aliased constant S := "/VERBOSE " & - "-v"; - -- /NOVERBOSE (D) - -- /VERBOSE - -- - -- Verbose mode; GNAT PRETTY generates version information and then a - -- trace of the actions it takes to produce or obtain the ASIS tree. - - Setup_Switches : aliased constant Switches := - (S_Setup_Ext 'Access, - S_Setup_Mess 'Access, - S_Setup_Project 'Access, - S_Setup_Quiet 'Access, - S_Setup_Verbose 'Access); - ------------------------------ -- Switches for GNAT SHARED -- ------------------------------ @@ -5390,6 +5375,185 @@ package VMS_Data is S_Shared_Verb 'Access, S_Shared_ZZZZZ 'Access); + ----------------------------- + -- Switches for GNAT STACK -- + ----------------------------- + + S_Stack_All : aliased constant S := "/ALL_SUBPROGRAMS " & + "-a"; + -- /NOALL_SUBPROGRAMS (D) + -- /ALL_SUBPROGRAMS + -- + -- Consider all subprograms as entry points. + + S_Stack_All_Cycles : aliased constant S := "/ALL_CYCLES " & + "-ca"; + -- /NOALL_CYCLES (D) + -- /ALL_CYCLES + -- + -- Extract all possible cycles in the call graph. + + S_Stack_All_Prjs : aliased constant S := "/ALL_PROJECTS " & + "-U"; + -- /NOALL_PROJECTS (D) + -- /ALL_PROJECTS + -- + -- When GNAT STACK is used with a Project File and no source is + -- specified, the underlying tool gnatstack is called for all the + -- units of all the Project Files in the project tree. + + S_Stack_Debug : aliased constant S := "/DEBUG " & + "-g"; + -- /NODEBUG (D) + -- /DEBUG + -- + -- Generate internal debug information. + + S_Stack_Directory : aliased constant S := "/DIRECTORY=*" & + "-aO*"; + -- /DIRECTORY=(direc[,...]) + -- + -- When looking for .ci files look also in directories specified. + + S_Stack_Entries : aliased constant S := "/ENTRIES=*" & + "-e*"; + -- + -- /ENTRY=(entry_point[,...]) + -- + -- Name of symbol to be used as entry point for the analysis. + + S_Stack_Files : aliased constant S := "/FILES=@" & + "-files=@"; + -- /FILES=filename + -- + -- Take as arguments the files that are listed in the specified + -- text file. + + S_Stack_Help : aliased constant S := "/HELP " & + "-h"; + -- /NOHELP (D) + -- /HELP + -- + -- Output a message explaining the usage of gnatstack. + + S_Stack_List : aliased constant S := "/LIST=#" & + "-l#"; + -- /LIST=nnn + -- + -- Print the nnn subprograms requiring the biggest local stack usage. By + -- default none will be displayed. + + S_Stack_Order : aliased constant S := "/ORDER=" & + "STACK " & + "-os " & + "ALPHABETICAL " & + "-oa"; + -- /ORDER[=order-option] + -- + -- Specifies the order for displaying the different call graphs. + -- order-option may be one of the following: + -- + -- STACK (D) Select stack usage order + -- + -- ALPHABETICAL Select alphabetical order + + S_Stack_Path : aliased constant S := "/PATH " & + "-p"; + -- /NOPATH (D) + -- /PATH + -- + -- Print all the subprograms that make up the worst-case path for every + -- entry point. + + S_Stack_Project : aliased constant S := "/PROJECT_FILE=<" & + "-P>"; + -- /PROJECT_FILE=filename + -- + -- Specifies the main project file to be used. The project files rooted + -- at the main project file will be parsed before the invocation of + -- gnatstack. + + S_Stack_Output : aliased constant S := "/OUTPUT=@" & + "-f@"; + -- /OUTPUT=filename + -- + -- Name of the file containing the generated graph (VCG format). + + S_Stack_Regexp : aliased constant S := "/EXPRESSION=|" & + "-r|"; + -- + -- /EXPRESSION=regular-expression + -- + -- Any symbol matching the regular expression will be considered as a + -- potential entry point for the analysis. + + S_Stack_Unbounded : aliased constant S := "/UNBOUNDED=#" & + "-d#"; + -- /UNBOUNDED=nnn + -- + -- Default stack size to be used for unbounded (dynamic) frames. + + S_Stack_Unknown : aliased constant S := "/UNKNOWN=#" & + "-u#"; + -- /UNKNOWN=nnn + -- + -- Default stack size to be used for unknown (external) calls. + + S_Stack_Verbose : aliased constant S := "/VERBOSE " & + "-v"; + -- /NOVERBOSE (D) + -- /VERBOSE + -- + -- Specifies the amount of information to be displayed about the + -- different subprograms. In verbose mode the full location of the + -- subprogram will be part of the output, as well as detailed information + -- about inaccurate data. + + S_Stack_Warnings : aliased constant S := "/WARNINGS=" & + "ALL " & + "-Wa " & + "CYCLES " & + "-Wc " & + "UNBOUNDED " & + "-Wu " & + "EXTERNAL " & + "-We " & + "INDIRECT " & + "-Wi"; + -- /WARNINGS[=(keyword[,...])] + -- + -- The following keywords are supported: + -- + -- ALL Turn on all optional warnings + -- + -- CYCLES Turn on warnings for cycles + -- + -- UNBOUNDED Turn on warnings for unbounded frames + -- + -- EXTERNAL Turn on warnings for external calls + -- + -- INDIRECT Turn on warnings for indirect calls + + Stack_Switches : aliased constant Switches := + (S_Stack_All 'Access, + S_Stack_All_Cycles 'Access, + S_Stack_All_Prjs 'Access, + S_Stack_Debug 'Access, + S_Stack_Directory 'Access, + S_Stack_Entries 'Access, + S_Stack_Files 'Access, + S_Stack_Help 'Access, + S_Stack_List 'Access, + S_Stack_Order 'Access, + S_Stack_Path 'Access, + S_Stack_Project 'Access, + S_Stack_Output 'Access, + S_Stack_Regexp 'Access, + S_Stack_Unbounded 'Access, + S_Stack_Unknown 'Access, + S_Stack_Verbose 'Access, + S_Stack_Warnings 'Access); + ---------------------------- -- Switches for GNAT STUB -- ---------------------------- |