Skip to content

R
riscv-gcc-1
Commit a5fe079c by Arnaud Charlet
Options

[multiple changes] 

2012-07-30  Robert Dewar  <dewar@adacore.com>

	* bindusg.adb: Clarify file in -A lines.

2012-07-30  Robert Dewar  <dewar@adacore.com>

	* freeze.adb: Minor reformatting.

2012-07-30  Robert Dewar  <dewar@adacore.com>

	* gnatcmd.adb, makeutl.adb, makeutl.ads: Minor code reorganization.

2012-07-30  Vincent Pucci  <pucci@adacore.com>

	* exp_ch9.adb (Build_Lock_Free_Unprotected_Subprogram_Body): Minor
	reformatting.
	* sem_ch9.adb (Allows_Lock_Free_Implementation): Minor reformatting.
	Capture the correct error message in case of a quantified expression.

2012-07-30  Thomas Quinot  <quinot@adacore.com>

	* g-socket.adb (Get_Socket_Option, Set_Socket_Option): On Windows, the
	value is a milliseconds count in a DWORD, not a struct timeval.

From-SVN: r189979
parent ea2af26a
Showing with 340 additions and 252 deletions
gcc/ada/ChangeLog
2012-07-30 Robert Dewar <dewar@adacore.com>
* bindusg.adb: Clarify file in -A lines.
2012-07-30 Robert Dewar <dewar@adacore.com>
* freeze.adb: Minor reformatting.
2012-07-30 Robert Dewar <dewar@adacore.com>
* gnatcmd.adb, makeutl.adb, makeutl.ads: Minor code reorganization.
2012-07-30 Vincent Pucci <pucci@adacore.com>
* exp_ch9.adb (Build_Lock_Free_Unprotected_Subprogram_Body): Minor
reformatting.
* sem_ch9.adb (Allows_Lock_Free_Implementation): Minor reformatting.
Capture the correct error message in case of a quantified expression.
2012-07-30 Thomas Quinot <quinot@adacore.com>
* g-socket.adb (Get_Socket_Option, Set_Socket_Option): On Windows, the
value is a milliseconds count in a DWORD, not a struct timeval.
2012-07-30 Hristian Kirtchev <kirtchev@adacore.com> 2012-07-30 Hristian Kirtchev <kirtchev@adacore.com>
* sem_ch12.adb (Earlier): Add local variables T1 and T2. Minor code * sem_ch12.adb (Earlier): Add local variables T1 and T2. Minor code
......
gcc/ada/bindusg.adb
...@@ -76,9 +76,10 @@ package body Bindusg is ...@@ -76,9 +76,10 @@ package body Bindusg is
Write_Line (" -a Automatically initialize elaboration " & Write_Line (" -a Automatically initialize elaboration " &
"procedure"); "procedure");
-- Line for -A switch -- Lines for -A switch
Write_Line (" -A[=file] Give list of ALI files in partition"); Write_Line (" -A Give list of ALI files in partition");
Write_Line (" -A=file Write ALI file list to named file");
-- Line for -b switch -- Line for -b switch
......
gcc/ada/exp_ch9.adb
...@@ -3260,9 +3260,6 @@ package body Exp_Ch9 is ...@@ -3260,9 +3260,6 @@ package body Exp_Ch9 is
begin begin
-- Get the type size -- Get the type size
-- Surely this should be Known_Static_Esize if you are about
-- to assume you can do UI_To_Int on it! ???
if Known_Esize (Comp_Type) then if Known_Esize (Comp_Type) then
Typ_Size := UI_To_Int (Esize (Comp_Type)); Typ_Size := UI_To_Int (Esize (Comp_Type));
...@@ -3270,10 +3267,14 @@ package body Exp_Ch9 is ...@@ -3270,10 +3267,14 @@ package body Exp_Ch9 is
-- the RM_Size (Value_Size) since it may have been set by an -- the RM_Size (Value_Size) since it may have been set by an
-- explicit representation clause. -- explicit representation clause.
-- And how do we know this is statically known??? elsif Known_RM_Size (Comp_Type) then
Typ_Size := UI_To_Int (RM_Size (Comp_Type));
-- Should not happen since this has already been checked in
-- Allows_Lock_Free_Implementation (see Sem_Ch9).
else else
Typ_Size := UI_To_Int (RM_Size (Comp_Type)); raise Program_Error;
end if; end if;
-- Retrieve all relevant atomic routines and types -- Retrieve all relevant atomic routines and types
......
gcc/ada/freeze.adb
...@@ -4204,12 +4204,12 @@ package body Freeze is ...@@ -4204,12 +4204,12 @@ package body Freeze is
elsif Is_Access_Type (E) elsif Is_Access_Type (E)
and then not Is_Access_Subprogram_Type (E) and then not Is_Access_Subprogram_Type (E)
then then
-- If a pragma Default_Storage_Pool applies, and this type has no -- If a pragma Default_Storage_Pool applies, and this type has no
-- Storage_Pool or Storage_Size clause (which must have occurred -- Storage_Pool or Storage_Size clause (which must have occurred
-- before the freezing point), then use the default. This applies -- before the freezing point), then use the default. This applies
-- only to base types. -- only to base types.
-- None of this applies to access to subprogramss, for which there
-- None of this applies to access to subprograms, for which there
-- are clearly no pools. -- are clearly no pools.
if Present (Default_Pool) if Present (Default_Pool)
......
gcc/ada/g-socket.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2001-2011, AdaCore -- -- Copyright (C) 2001-2012, AdaCore --
-- -- -- --
-- 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- --
...@@ -1112,6 +1112,7 @@ package body GNAT.Sockets is ...@@ -1112,6 +1112,7 @@ package body GNAT.Sockets is
Level : Level_Type := Socket_Level; Level : Level_Type := Socket_Level;
Name : Option_Name) return Option_Type Name : Option_Name) return Option_Type
is is
use SOSC;
use type C.unsigned_char; use type C.unsigned_char;
V8 : aliased Two_Ints; V8 : aliased Two_Ints;
...@@ -1144,8 +1145,22 @@ package body GNAT.Sockets is ...@@ -1144,8 +1145,22 @@ package body GNAT.Sockets is
when Send_Timeout | when Send_Timeout |
Receive_Timeout => Receive_Timeout =>
Len := VT'Size / 8;
Add := VT'Address; -- The standard argument for SO_RCVTIMEO and SO_SNDTIMEO is a
-- struct timeval, but on Windows it is a milliseconds count in
-- a DWORD.
pragma Warnings (Off);
if Target_OS = Windows then
pragma Warnings (On);
Len := V4'Size / 8;
Add := V4'Address;
else
Len := VT'Size / 8;
Add := VT'Address;
end if;
when Linger | when Linger |
Add_Membership | Add_Membership |
...@@ -1201,7 +1216,23 @@ package body GNAT.Sockets is ...@@ -1201,7 +1216,23 @@ package body GNAT.Sockets is
when Send_Timeout | when Send_Timeout |
Receive_Timeout => Receive_Timeout =>
Opt.Timeout := To_Duration (VT);
pragma Warnings (Off);
if Target_OS = Windows then
pragma Warnings (On);
-- Timeout is in milliseconds, actual value is 500 ms +
-- returned value (unless it is 0).
if V4 = 0 then
Opt.Timeout := 0.0;
else
Opt.Timeout := Natural (V4) * 0.001 + 0.500;
end if;
else
Opt.Timeout := To_Duration (VT);
end if;
end case; end case;
return Opt; return Opt;
...@@ -2176,6 +2207,8 @@ package body GNAT.Sockets is ...@@ -2176,6 +2207,8 @@ package body GNAT.Sockets is
Level : Level_Type := Socket_Level; Level : Level_Type := Socket_Level;
Option : Option_Type) Option : Option_Type)
is is
use SOSC;
V8 : aliased Two_Ints; V8 : aliased Two_Ints;
V4 : aliased C.int; V4 : aliased C.int;
V1 : aliased C.unsigned_char; V1 : aliased C.unsigned_char;
...@@ -2236,9 +2269,32 @@ package body GNAT.Sockets is ...@@ -2236,9 +2269,32 @@ package body GNAT.Sockets is
when Send_Timeout | when Send_Timeout |
Receive_Timeout => Receive_Timeout =>
VT := To_Timeval (Option.Timeout);
Len := VT'Size / 8; pragma Warnings (Off);
Add := VT'Address; if Target_OS = Windows then
pragma Warnings (On);
-- On Windows, the timeout is a DWORD in milliseconds, and
-- the actual timeout is 500 ms + the given value (unless it
-- is 0).
V4 := C.int (Option.Timeout / 0.001);
if V4 > 500 then
V4 := V4 - 500;
elsif V4 > 0 then
V4 := 1;
end if;
Len := V4'Size / 8;
Add := V4'Address;
else
VT := To_Timeval (Option.Timeout);
Len := VT'Size / 8;
Add := VT'Address;
end if;
end case; end case;
......
gcc/ada/gnatcmd.adb
...@@ -238,12 +238,7 @@ procedure GNATCmd is ...@@ -238,12 +238,7 @@ procedure GNATCmd is
function Configuration_Pragmas_File return Path_Name_Type; function Configuration_Pragmas_File return Path_Name_Type;
-- Return an argument, if there is a configuration pragmas file to be -- Return an argument, if there is a configuration pragmas file to be
-- specified for Project, otherwise return No_Name. Used for gnatstub (GNAT -- specified for Project, otherwise return No_Name. Used for gnatstub
-- STUB), gnatpp (GNAT PRETTY), gnatelim (GNAT ELIM), and gnatmetric (GNAT
-- METRIC).
function Mapping_File return Path_Name_Type;
-- Create and return the path name of a mapping file. Used for gnatstub
-- (GNAT STUB), gnatpp (GNAT PRETTY), gnatelim (GNAT ELIM), and gnatmetric -- (GNAT STUB), gnatpp (GNAT PRETTY), gnatelim (GNAT ELIM), and gnatmetric
-- (GNAT METRIC). -- (GNAT METRIC).
...@@ -251,10 +246,22 @@ procedure GNATCmd is ...@@ -251,10 +246,22 @@ procedure GNATCmd is
-- Delete all temporary config files. The caller is responsible for -- Delete all temporary config files. The caller is responsible for
-- ensuring that Keep_Temporary_Files is False. -- ensuring that Keep_Temporary_Files is False.
procedure Ensure_Absolute_Path
(Switch : in out String_Access;
Parent : String);
-- Test if Switch is a relative search path switch. If it is and it
-- includes directory information, prepend the path with Parent. This
-- subprogram is only called when using project files.
procedure Get_Closure; procedure Get_Closure;
-- Get the sources in the closure of the ASIS_Main and add them to the -- Get the sources in the closure of the ASIS_Main and add them to the
-- list of arguments. -- list of arguments.
function Mapping_File return Path_Name_Type;
-- Create and return the path name of a mapping file. Used for gnatstub
-- (GNAT STUB), gnatpp (GNAT PRETTY), gnatelim (GNAT ELIM), and gnatmetric
-- (GNAT METRIC).
procedure Non_VMS_Usage; procedure Non_VMS_Usage;
-- Display usage for platforms other than VMS -- Display usage for platforms other than VMS
...@@ -268,17 +275,9 @@ procedure GNATCmd is ...@@ -268,17 +275,9 @@ procedure GNATCmd is
-- If Project is a library project, add the correct -L and -l switches to -- If Project is a library project, add the correct -L and -l switches to
-- the linker invocation. -- the linker invocation.
procedure Set_Libraries is procedure Set_Libraries is new
new For_Every_Project_Imported (Boolean, Set_Library_For); For_Every_Project_Imported (Boolean, Set_Library_For);
-- Add the -L and -l switches to the linker for all of the library -- Add the -L and -l switches to the linker for all the library projects
-- projects.
procedure Ensure_Absolute_Path
(Switch : in out String_Access;
Parent : String);
-- Test if Switch is a relative search path switch. If it is and it
-- includes directory information, prepend the path with Parent. This
-- subprogram is only called when using project files.
-------------------------- --------------------------
-- Add_To_Carg_Switches -- -- Add_To_Carg_Switches --
...@@ -789,6 +788,22 @@ procedure GNATCmd is ...@@ -789,6 +788,22 @@ procedure GNATCmd is
end if; end if;
end Delete_Temp_Config_Files; end Delete_Temp_Config_Files;
---------------------------
-- Ensure_Absolute_Path --
---------------------------
procedure Ensure_Absolute_Path
(Switch : in out String_Access;
Parent : String)
is
begin
Makeutl.Ensure_Absolute_Path
(Switch, Parent,
Do_Fail => Osint.Fail'Access,
Including_Non_Switch => False,
Including_RTS => True);
end Ensure_Absolute_Path;
----------------- -----------------
-- Get_Closure -- -- Get_Closure --
----------------- -----------------
...@@ -962,6 +977,59 @@ procedure GNATCmd is ...@@ -962,6 +977,59 @@ procedure GNATCmd is
return Result; return Result;
end Mapping_File; end Mapping_File;
-------------------
-- Non_VMS_Usage --
-------------------
procedure Non_VMS_Usage is
begin
Output_Version;
New_Line;
Put_Line ("List of available commands");
New_Line;
for C in Command_List'Range loop
-- No usage for VMS only command or for Sync
if not Command_List (C).VMS_Only and then C /= Sync then
if Targparm.AAMP_On_Target then
Put ("gnaampcmd ");
else
Put ("gnat ");
end if;
Put (To_Lower (Command_List (C).Cname.all));
Set_Col (25);
-- Never call gnatstack with a prefix
if C = Stack then
Put (Command_List (C).Unixcmd.all);
else
Put (Program_Name (Command_List (C).Unixcmd.all, "gnat").all);
end if;
declare
Sws : Argument_List_Access renames Command_List (C).Unixsws;
begin
if Sws /= null then
for J in Sws'Range loop
Put (' ');
Put (Sws (J).all);
end loop;
end if;
end;
New_Line;
end if;
end loop;
New_Line;
Put_Line ("All commands except chop, krunch and preprocess " &
"accept project file switches -vPx, -Pprj and -Xnam=val");
New_Line;
end Non_VMS_Usage;
------------------ ------------------
-- Process_Link -- -- Process_Link --
------------------ ------------------
...@@ -1302,76 +1370,6 @@ procedure GNATCmd is ...@@ -1302,76 +1370,6 @@ procedure GNATCmd is
end if; end if;
end Set_Library_For; end Set_Library_For;
---------------------------
-- Ensure_Absolute_Path --
---------------------------
procedure Ensure_Absolute_Path
(Switch : in out String_Access;
Parent : String)
is
begin
Makeutl.Ensure_Absolute_Path
(Switch, Parent,
Do_Fail => Osint.Fail'Access,
Including_Non_Switch => False,
Including_RTS => True);
end Ensure_Absolute_Path;
-------------------
-- Non_VMS_Usage --
-------------------
procedure Non_VMS_Usage is
begin
Output_Version;
New_Line;
Put_Line ("List of available commands");
New_Line;
for C in Command_List'Range loop
-- No usage for VMS only command or for Sync
if not Command_List (C).VMS_Only and then C /= Sync then
if Targparm.AAMP_On_Target then
Put ("gnaampcmd ");
else
Put ("gnat ");
end if;
Put (To_Lower (Command_List (C).Cname.all));
Set_Col (25);
-- Never call gnatstack with a prefix
if C = Stack then
Put (Command_List (C).Unixcmd.all);
else
Put (Program_Name (Command_List (C).Unixcmd.all, "gnat").all);
end if;
declare
Sws : Argument_List_Access renames Command_List (C).Unixsws;
begin
if Sws /= null then
for J in Sws'Range loop
Put (' ');
Put (Sws (J).all);
end loop;
end if;
end;
New_Line;
end if;
end loop;
New_Line;
Put_Line ("All commands except chop, krunch and preprocess " &
"accept project file switches -vPx, -Pprj and -Xnam=val");
New_Line;
end Non_VMS_Usage;
-- Start of processing for GNATCmd -- Start of processing for GNATCmd
begin begin
......
gcc/ada/makeutl.adb
...@@ -507,6 +507,109 @@ package body Makeutl is ...@@ -507,6 +507,109 @@ package body Makeutl is
return Name_Find; return Name_Find;
end Create_Name; end Create_Name;
---------------------------
-- Ensure_Absolute_Path --
---------------------------
procedure Ensure_Absolute_Path
(Switch : in out String_Access;
Parent : String;
Do_Fail : Fail_Proc;
For_Gnatbind : Boolean := False;
Including_Non_Switch : Boolean := True;
Including_RTS : Boolean := False)
is
begin
if Switch /= null then
declare
Sw : String (1 .. Switch'Length);
Start : Positive;
begin
Sw := Switch.all;
if Sw (1) = '-' then
if Sw'Length >= 3
and then (Sw (2) = 'I'
or else (not For_Gnatbind
and then (Sw (2) = 'L'
or else Sw (2) = 'A')))
then
Start := 3;
if Sw = "-I-" then
return;
end if;
elsif Sw'Length >= 4
and then (Sw (2 .. 3) = "aL"
or else
Sw (2 .. 3) = "aO"
or else
Sw (2 .. 3) = "aI"
or else
(For_Gnatbind and then Sw (2 .. 3) = "A="))
then
Start := 4;
elsif Including_RTS
and then Sw'Length >= 7
and then Sw (2 .. 6) = "-RTS="
then
Start := 7;
else
return;
end if;
-- Because relative path arguments to --RTS= may be relative to
-- the search directory prefix, those relative path arguments
-- are converted only when they include directory information.
if not Is_Absolute_Path (Sw (Start .. Sw'Last)) then
if Parent'Length = 0 then
Do_Fail
("relative search path switches ("""
& Sw
& """) are not allowed");
elsif Including_RTS then
for J in Start .. Sw'Last loop
if Sw (J) = Directory_Separator then
Switch :=
new String'
(Sw (1 .. Start - 1) &
Parent &
Directory_Separator &
Sw (Start .. Sw'Last));
return;
end if;
end loop;
else
Switch :=
new String'
(Sw (1 .. Start - 1) &
Parent &
Directory_Separator &
Sw (Start .. Sw'Last));
end if;
end if;
elsif Including_Non_Switch then
if not Is_Absolute_Path (Sw) then
if Parent'Length = 0 then
Do_Fail
("relative paths (""" & Sw & """) are not allowed");
else
Switch := new String'(Parent & Directory_Separator & Sw);
end if;
end if;
end if;
end;
end if;
end Ensure_Absolute_Path;
---------------------------- ----------------------------
-- Executable_Prefix_Path -- -- Executable_Prefix_Path --
---------------------------- ----------------------------
...@@ -1936,109 +2039,6 @@ package body Makeutl is ...@@ -1936,109 +2039,6 @@ package body Makeutl is
end if; end if;
end Path_Or_File_Name; end Path_Or_File_Name;
---------------------------
-- Ensure_Absolute_Path --
---------------------------
procedure Ensure_Absolute_Path
(Switch : in out String_Access;
Parent : String;
Do_Fail : Fail_Proc;
For_Gnatbind : Boolean := False;
Including_Non_Switch : Boolean := True;
Including_RTS : Boolean := False)
is
begin
if Switch /= null then
declare
Sw : String (1 .. Switch'Length);
Start : Positive;
begin
Sw := Switch.all;
if Sw (1) = '-' then
if Sw'Length >= 3
and then (Sw (2) = 'I'
or else (not For_Gnatbind
and then (Sw (2) = 'L'
or else Sw (2) = 'A')))
then
Start := 3;
if Sw = "-I-" then
return;
end if;
elsif Sw'Length >= 4
and then (Sw (2 .. 3) = "aL"
or else
Sw (2 .. 3) = "aO"
or else
Sw (2 .. 3) = "aI"
or else
(For_Gnatbind and then Sw (2 .. 3) = "A="))
then
Start := 4;
elsif Including_RTS
and then Sw'Length >= 7
and then Sw (2 .. 6) = "-RTS="
then
Start := 7;
else
return;
end if;
-- Because relative path arguments to --RTS= may be relative to
-- the search directory prefix, those relative path arguments
-- are converted only when they include directory information.
if not Is_Absolute_Path (Sw (Start .. Sw'Last)) then
if Parent'Length = 0 then
Do_Fail
("relative search path switches ("""
& Sw
& """) are not allowed");
elsif Including_RTS then
for J in Start .. Sw'Last loop
if Sw (J) = Directory_Separator then
Switch :=
new String'
(Sw (1 .. Start - 1) &
Parent &
Directory_Separator &
Sw (Start .. Sw'Last));
return;
end if;
end loop;
else
Switch :=
new String'
(Sw (1 .. Start - 1) &
Parent &
Directory_Separator &
Sw (Start .. Sw'Last));
end if;
end if;
elsif Including_Non_Switch then
if not Is_Absolute_Path (Sw) then
if Parent'Length = 0 then
Do_Fail
("relative paths (""" & Sw & """) are not allowed");
else
Switch := new String'(Parent & Directory_Separator & Sw);
end if;
end if;
end if;
end;
end if;
end Ensure_Absolute_Path;
------------------- -------------------
-- Unit_Index_Of -- -- Unit_Index_Of --
------------------- -------------------
......
gcc/ada/makeutl.ads
...@@ -128,6 +128,20 @@ package Makeutl is ...@@ -128,6 +128,20 @@ package Makeutl is
-- source files are still associated with the same units). Return the name -- source files are still associated with the same units). Return the name
-- of the unit if everything is still valid. Return No_Name otherwise. -- of the unit if everything is still valid. Return No_Name otherwise.
procedure Ensure_Absolute_Path
(Switch : in out String_Access;
Parent : String;
Do_Fail : Fail_Proc;
For_Gnatbind : Boolean := False;
Including_Non_Switch : Boolean := True;
Including_RTS : Boolean := False);
-- Do nothing if Switch is an absolute path switch. If relative, fail if
-- Parent is the empty string, otherwise prepend the path with Parent. This
-- subprogram is only used when using project files. If For_Gnatbind is
-- True, gnatbind switches that are not paths (-L, -A) are left unchaned.
-- If Including_RTS is True, process also switches --RTS=. Do_Fail is
-- called in case of error. Using Osint.Fail might be appropriate.
function Is_Subunit (Source : Source_Id) return Boolean; function Is_Subunit (Source : Source_Id) return Boolean;
-- Return True if source is a subunit -- Return True if source is a subunit
...@@ -151,26 +165,6 @@ package Makeutl is ...@@ -151,26 +165,6 @@ package Makeutl is
-- entered by a call to Prj.Ext.Add, so that in a project file, External -- entered by a call to Prj.Ext.Add, so that in a project file, External
-- ("name") will return "value". -- ("name") will return "value".
procedure Verbose_Msg
(N1 : Name_Id;
S1 : String;
N2 : Name_Id := No_Name;
S2 : String := "";
Prefix : String := " -> ";
Minimum_Verbosity : Opt.Verbosity_Level_Type := Opt.Low);
procedure Verbose_Msg
(N1 : File_Name_Type;
S1 : String;
N2 : File_Name_Type := No_File;
S2 : String := "";
Prefix : String := " -> ";
Minimum_Verbosity : Opt.Verbosity_Level_Type := Opt.Low);
-- If the verbose flag (Verbose_Mode) is set and the verbosity level is at
-- least equal to Minimum_Verbosity, then print Prefix to standard output
-- followed by N1 and S1. If N2 /= No_Name then N2 is printed after S1. S2
-- is printed last. Both N1 and N2 are printed in quotation marks. The two
-- forms differ only in taking Name_Id or File_name_Type arguments.
type Name_Ids is array (Positive range <>) of Name_Id; type Name_Ids is array (Positive range <>) of Name_Id;
No_Names : constant Name_Ids := (1 .. 0 => No_Name); No_Names : constant Name_Ids := (1 .. 0 => No_Name);
-- Name_Ids is used for list of language names in procedure Get_Directories -- Name_Ids is used for list of language names in procedure Get_Directories
...@@ -231,26 +225,32 @@ package Makeutl is ...@@ -231,26 +225,32 @@ package Makeutl is
-- of project Project, in project tree In_Tree, and in the projects that -- of project Project, in project tree In_Tree, and in the projects that
-- it imports directly or indirectly, and returns the result. -- it imports directly or indirectly, and returns the result.
function Path_Or_File_Name (Path : Path_Name_Type) return String;
-- Returns a file name if -df is used, otherwise return a path name
function Unit_Index_Of (ALI_File : File_Name_Type) return Int; function Unit_Index_Of (ALI_File : File_Name_Type) return Int;
-- Find the index of a unit in a source file. Return zero if the file is -- Find the index of a unit in a source file. Return zero if the file is
-- not a multi-unit source file. -- not a multi-unit source file.
procedure Ensure_Absolute_Path procedure Verbose_Msg
(Switch : in out String_Access; (N1 : Name_Id;
Parent : String; S1 : String;
Do_Fail : Fail_Proc; N2 : Name_Id := No_Name;
For_Gnatbind : Boolean := False; S2 : String := "";
Including_Non_Switch : Boolean := True; Prefix : String := " -> ";
Including_RTS : Boolean := False); Minimum_Verbosity : Opt.Verbosity_Level_Type := Opt.Low);
-- Do nothing if Switch is an absolute path switch. If relative, fail if procedure Verbose_Msg
-- Parent is the empty string, otherwise prepend the path with Parent. This (N1 : File_Name_Type;
-- subprogram is only used when using project files. If For_Gnatbind is S1 : String;
-- True, gnatbind switches that are not paths (-L, -A) are left unchaned. N2 : File_Name_Type := No_File;
-- If Including_RTS is True, process also switches --RTS=. Do_Fail is S2 : String := "";
-- called in case of error. Using Osint.Fail might be appropriate. Prefix : String := " -> ";
Minimum_Verbosity : Opt.Verbosity_Level_Type := Opt.Low);
function Path_Or_File_Name (Path : Path_Name_Type) return String; -- If the verbose flag (Verbose_Mode) is set and the verbosity level is at
-- Returns a file name if -df is used, otherwise return a path name -- least equal to Minimum_Verbosity, then print Prefix to standard output
-- followed by N1 and S1. If N2 /= No_Name then N2 is printed after S1. S2
-- is printed last. Both N1 and N2 are printed in quotation marks. The two
-- forms differ only in taking Name_Id or File_name_Type arguments.
------------------------- -------------------------
-- Program termination -- -- Program termination --
...@@ -279,10 +279,11 @@ package Makeutl is ...@@ -279,10 +279,11 @@ package Makeutl is
For_Lang : Name_Id; For_Lang : Name_Id;
For_Builder : Boolean; For_Builder : Boolean;
Has_Global_Compilation_Switches : Boolean) return Boolean; Has_Global_Compilation_Switches : Boolean) return Boolean;
-- For_Builder is true if we have a builder switch -- For_Builder is true if we have a builder switch. This function
-- This function should return True in case of success (the switch is -- should return True in case of success (the switch is valid),
-- valid), False otherwise. The error message will be displayed by -- False otherwise. The error message will be displayed by
-- Compute_Builder_Switches itself. -- Compute_Builder_Switches itself.
--
-- Has_Global_Compilation_Switches is True if the attribute -- Has_Global_Compilation_Switches is True if the attribute
-- Global_Compilation_Switches is defined in the project. -- Global_Compilation_Switches is defined in the project.
...@@ -291,10 +292,10 @@ package Makeutl is ...@@ -291,10 +292,10 @@ package Makeutl is
Root_Environment : in out Prj.Tree.Environment; Root_Environment : in out Prj.Tree.Environment;
Main_Project : Project_Id; Main_Project : Project_Id;
Only_For_Lang : Name_Id := No_Name); Only_For_Lang : Name_Id := No_Name);
-- Compute the builder switches and global compilation switches. -- Compute the builder switches and global compilation switches. Every time
-- Every time a switch is found in the project, it is passed to Add_Switch. -- a switch is found in the project, it is passed to Add_Switch. You can
-- You can provide a value for Only_For_Lang so that we only look for -- provide a value for Only_For_Lang so that we only look for this language
-- this language when parsing the global compilation switches. -- when parsing the global compilation switches.
----------------------- -----------------------
-- Project_Tree data -- -- Project_Tree data --
......
gcc/ada/sem_ch9.adb
...@@ -530,7 +530,10 @@ package body Sem_Ch9 is ...@@ -530,7 +530,10 @@ package body Sem_Ch9 is
-- Quantified expression restricted -- Quantified expression restricted
elsif Kind = N_Quantified_Expression then elsif Kind = N_Quantified_Expression
or else Nkind (Original_Node (N)) =
N_Quantified_Expression
then
if Lock_Free_Given then if Lock_Free_Given then
Error_Msg_N ("quantified expression not allowed", Error_Msg_N ("quantified expression not allowed",
N); N);
...@@ -552,7 +555,7 @@ package body Sem_Ch9 is ...@@ -552,7 +555,7 @@ package body Sem_Ch9 is
Id : constant Entity_Id := Entity (N); Id : constant Entity_Id := Entity (N);
Comp_Decl : Node_Id; Comp_Decl : Node_Id;
Comp_Id : Entity_Id := Empty; Comp_Id : Entity_Id := Empty;
Comp_Size : Int; Comp_Size : Int := 0;
Comp_Type : Entity_Id; Comp_Type : Entity_Id;
begin begin
...@@ -579,6 +582,10 @@ package body Sem_Ch9 is ...@@ -579,6 +582,10 @@ package body Sem_Ch9 is
Layout_Type (Comp_Type); Layout_Type (Comp_Type);
-- Note that Known_Esize is used and not
-- Known_Static_Esize in order to capture the
-- errors properly at the instantiation point.
if Known_Esize (Comp_Type) then if Known_Esize (Comp_Type) then
Comp_Size := UI_To_Int (Esize (Comp_Type)); Comp_Size := UI_To_Int (Esize (Comp_Type));
...@@ -587,7 +594,7 @@ package body Sem_Ch9 is ...@@ -587,7 +594,7 @@ package body Sem_Ch9 is
-- (Value_Size) since it may have been set by an -- (Value_Size) since it may have been set by an
-- explicit representation clause. -- explicit representation clause.
else elsif Known_RM_Size (Comp_Type) then
Comp_Size := UI_To_Int (RM_Size (Comp_Type)); Comp_Size := UI_To_Int (RM_Size (Comp_Type));
end if; end if;
......
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