Commit e1d9659d by Arnaud Charlet

[multiple changes]

2010-09-10  Robert Dewar  <dewar@adacore.com>

	* errout.adb: Remove tests of Parsing_Main_Subunit, since this test is
	now done in In_Extended_Main_Source_Unit.
	* errout.ads (Compiler_State[_Type]): Moved from Errout to Lib
	(Parsing_Main_Subunit): Moved from Errout to Lib and renamed
	as Parsing_Main_Extended_Source.
	* frontend.adb: Set Parsing_Main_Extended_Source True for parsing main
	unit.
	* lib-load.adb (Load_Unit): Add PMES parameter
	Set PMES appropriately in all calls to Load_Unit
	* lib-load.ads (Load_Unit): Add PMES parameter
	* lib.adb (In_Extended_Main_Source_Unit): When called with
	Compiler_State set to Parsing, test new flag
	Compiling_Main_Extended_Source.
	* lib.ads (Compiler_State[_Type]): Moved from Errout to Lib
	(Parsing_Main_Subunit): Moved from Errout to Lib and renamed
	as Parsing_Main_Extended_Source
	* par-load.adb (Load): Set PMES properly in call to Load_Unit

2010-09-10  Ed Schonberg  <schonberg@adacore.com>

	* exp_cg.adb: Use proper entity to handle overloads.
	* sem_res.adb (Check_Parameterless_Call): An operator node without
	actuals cannot be a call, and must be treated as a string.

From-SVN: r164182
parent cd9909a0
2010-09-10 Robert Dewar <dewar@adacore.com> 2010-09-10 Robert Dewar <dewar@adacore.com>
* errout.adb: Remove tests of Parsing_Main_Subunit, since this test is
now done in In_Extended_Main_Source_Unit.
* errout.ads (Compiler_State[_Type]): Moved from Errout to Lib
(Parsing_Main_Subunit): Moved from Errout to Lib and renamed
as Parsing_Main_Extended_Source.
* frontend.adb: Set Parsing_Main_Extended_Source True for parsing main
unit.
* lib-load.adb (Load_Unit): Add PMES parameter
Set PMES appropriately in all calls to Load_Unit
* lib-load.ads (Load_Unit): Add PMES parameter
* lib.adb (In_Extended_Main_Source_Unit): When called with
Compiler_State set to Parsing, test new flag
Compiling_Main_Extended_Source.
* lib.ads (Compiler_State[_Type]): Moved from Errout to Lib
(Parsing_Main_Subunit): Moved from Errout to Lib and renamed
as Parsing_Main_Extended_Source
* par-load.adb (Load): Set PMES properly in call to Load_Unit
2010-09-10 Ed Schonberg <schonberg@adacore.com>
* exp_cg.adb: Use proper entity to handle overloads.
* sem_res.adb (Check_Parameterless_Call): An operator node without
actuals cannot be a call, and must be treated as a string.
2010-09-10 Robert Dewar <dewar@adacore.com>
* frontend.adb: Minor reformatting. * frontend.adb: Minor reformatting.
2010-09-10 Robert Dewar <dewar@adacore.com> 2010-09-10 Robert Dewar <dewar@adacore.com>
......
...@@ -748,9 +748,7 @@ package body Errout is ...@@ -748,9 +748,7 @@ package body Errout is
-- If the flag location is in the main extended source unit then for -- If the flag location is in the main extended source unit then for
-- sure we want the warning since it definitely belongs -- sure we want the warning since it definitely belongs
if Parsing_Main_Subunit if In_Extended_Main_Source_Unit (Sptr) then
or else In_Extended_Main_Source_Unit (Sptr)
then
null; null;
-- If the flag location is not in the main extended source unit, then -- If the flag location is not in the main extended source unit, then
...@@ -1159,8 +1157,7 @@ package body Errout is ...@@ -1159,8 +1157,7 @@ package body Errout is
is is
begin begin
if Eflag if Eflag
and then (Parsing_Main_Subunit and then In_Extended_Main_Source_Unit (N)
or else In_Extended_Main_Source_Unit (N))
and then Comes_From_Source (N) and then Comes_From_Source (N)
then then
Error_Msg_NEL (Msg, N, N, Sloc (N)); Error_Msg_NEL (Msg, N, N, Sloc (N));
......
...@@ -60,21 +60,6 @@ package Errout is ...@@ -60,21 +60,6 @@ package Errout is
-- the use of constructs not permitted by the library in use, or improper -- the use of constructs not permitted by the library in use, or improper
-- constructs in No_Run_Time mode). -- constructs in No_Run_Time mode).
type Compiler_State_Type is (Parsing, Analyzing);
Compiler_State : Compiler_State_Type;
-- Indicates current state of compilation. This is put in the Errout spec
-- because it affects the handling of error messages. In particular, an
-- attempt is made by Errout to suppress cascaded error messages in Parsing
-- mode, but not in the other modes.
Parsing_Main_Subunit : Boolean := False;
-- Set True if we are currently parsing a subunit that is part of the main
-- extended source. We need this flag, since the In_Main_Extended_Source
-- test may produce an improper False value if called too early during the
-- parsing process. This is put in the Errout spec because it affects error
-- message handling. In particular, warnings and style messages during
-- parsing are only generated if this flag is set to True.
Current_Error_Source_File : Source_File_Index Current_Error_Source_File : Source_File_Index
renames Err_Vars.Current_Error_Source_File; renames Err_Vars.Current_Error_Source_File;
-- Id of current messages. Used to post file name when unit changes. This -- Id of current messages. Used to post file name when unit changes. This
......
...@@ -426,7 +426,19 @@ package body Exp_CG is ...@@ -426,7 +426,19 @@ package body Exp_CG is
begin begin
Write_Str ("edge: { sourcename: "); Write_Str ("edge: { sourcename: ");
Write_Char ('"'); Write_Char ('"');
Get_External_Name (Defining_Entity (P), Has_Suffix => False);
-- The parent node is the construct that contains the call: subprogram
-- body or library-level package. Display the qualified name of the
-- entity of the construct. For a subprogram, it is the entity of the
-- spec, which carries a homonym counter when it is overloaded.
if Nkind (P) = N_Subprogram_Body then
Get_External_Name (Corresponding_Spec (P), Has_Suffix => False);
else
Get_External_Name (Defining_Entity (P), Has_Suffix => False);
end if;
Write_Str (Name_Buffer (1 .. Name_Len)); Write_Str (Name_Buffer (1 .. Name_Len));
if Nkind (P) = N_Package_Declaration then if Nkind (P) = N_Package_Declaration then
......
...@@ -121,12 +121,17 @@ begin ...@@ -121,12 +121,17 @@ begin
Lib.Load.Load_Main_Source; Lib.Load.Load_Main_Source;
-- Return immediately if the main source could not be parsed -- Return immediately if the main source could not be found
if Sinput.Main_Source_File = No_Source_File then if Sinput.Main_Source_File = No_Source_File then
return; return;
end if; end if;
-- We set Parsing_Main_Extended_Source true here to cover processing of all
-- the configuration pragma files, as well as the main source unit itself.
Parsing_Main_Extended_Source := True;
-- Read and process configuration pragma files if present -- Read and process configuration pragma files if present
declare declare
...@@ -229,9 +234,9 @@ begin ...@@ -229,9 +234,9 @@ begin
Optimize_Alignment := 'T'; Optimize_Alignment := 'T';
end if; end if;
-- We have now processed the command line switches, and the gnat.adc -- We have now processed the command line switches, and the configuration
-- file, so this is the point at which we want to capture the values -- pragma files, so this is the point at which we want to capture the
-- of the configuration switches (see Opt for further details). -- values of the configuration switches (see Opt for further details).
Opt.Register_Opt_Config_Switches; Opt.Register_Opt_Config_Switches;
...@@ -252,6 +257,7 @@ begin ...@@ -252,6 +257,7 @@ begin
-- semantics in any case). -- semantics in any case).
Discard_List (Par (Configuration_Pragmas => False)); Discard_List (Par (Configuration_Pragmas => False));
Parsing_Main_Extended_Source := False;
-- The main unit is now loaded, and subunits of it can be loaded, -- The main unit is now loaded, and subunits of it can be loaded,
-- without reporting spurious loading circularities. -- without reporting spurious loading circularities.
......
...@@ -344,7 +344,8 @@ package body Lib.Load is ...@@ -344,7 +344,8 @@ package body Lib.Load is
Subunit : Boolean; Subunit : Boolean;
Corr_Body : Unit_Number_Type := No_Unit; Corr_Body : Unit_Number_Type := No_Unit;
Renamings : Boolean := False; Renamings : Boolean := False;
With_Node : Node_Id := Empty) return Unit_Number_Type With_Node : Node_Id := Empty;
PMES : Boolean := False) return Unit_Number_Type
is is
Calling_Unit : Unit_Number_Type; Calling_Unit : Unit_Number_Type;
Uname_Actual : Unit_Name_Type; Uname_Actual : Unit_Name_Type;
...@@ -352,10 +353,11 @@ package body Lib.Load is ...@@ -352,10 +353,11 @@ package body Lib.Load is
Unump : Unit_Number_Type; Unump : Unit_Number_Type;
Fname : File_Name_Type; Fname : File_Name_Type;
Src_Ind : Source_File_Index; Src_Ind : Source_File_Index;
Save_PMES : constant Boolean := Parsing_Main_Extended_Source;
-- Start of processing for Load_Unit
begin begin
Parsing_Main_Extended_Source := PMES;
-- If renamings are allowed and we have a child unit name, then we -- If renamings are allowed and we have a child unit name, then we
-- must first load the parent to deal with finding the real name. -- must first load the parent to deal with finding the real name.
-- Retain the with_clause that names the child, so that if it is -- Retain the with_clause that names the child, so that if it is
...@@ -372,6 +374,7 @@ package body Lib.Load is ...@@ -372,6 +374,7 @@ package body Lib.Load is
With_Node => With_Node); With_Node => With_Node);
if Unump = No_Unit then if Unump = No_Unit then
Parsing_Main_Extended_Source := Save_PMES;
return No_Unit; return No_Unit;
end if; end if;
...@@ -552,10 +555,12 @@ package body Lib.Load is ...@@ -552,10 +555,12 @@ package body Lib.Load is
end if; end if;
Write_Dependency_Chain; Write_Dependency_Chain;
return No_Unit; Unum := No_Unit;
goto Done;
else else
return No_Unit; Unum := No_Unit;
goto Done;
end if; end if;
end if; end if;
end loop; end loop;
...@@ -600,7 +605,8 @@ package body Lib.Load is ...@@ -600,7 +605,8 @@ package body Lib.Load is
Load_Stack.Decrement_Last; Load_Stack.Decrement_Last;
end if; end if;
return No_Unit; Unum := No_Unit;
goto Done;
end if; end if;
if Debug_Flag_L then if Debug_Flag_L then
...@@ -610,7 +616,7 @@ package body Lib.Load is ...@@ -610,7 +616,7 @@ package body Lib.Load is
end if; end if;
Load_Stack.Decrement_Last; Load_Stack.Decrement_Last;
return Unum; goto Done;
-- Unit is not already in table, so try to open the file -- Unit is not already in table, so try to open the file
...@@ -658,7 +664,7 @@ package body Lib.Load is ...@@ -658,7 +664,7 @@ package body Lib.Load is
declare declare
Save_Index : constant Nat := Multiple_Unit_Index; Save_Index : constant Nat := Multiple_Unit_Index;
Save_PMS : constant Boolean := Parsing_Main_Subunit; Save_PMES : constant Boolean := Parsing_Main_Extended_Source;
begin begin
Multiple_Unit_Index := Get_Unit_Index (Uname_Actual); Multiple_Unit_Index := Get_Unit_Index (Uname_Actual);
...@@ -666,12 +672,12 @@ package body Lib.Load is ...@@ -666,12 +672,12 @@ package body Lib.Load is
Initialize_Scanner (Unum, Source_Index (Unum)); Initialize_Scanner (Unum, Source_Index (Unum));
if Calling_Unit = Main_Unit and then Subunit then if Calling_Unit = Main_Unit and then Subunit then
Parsing_Main_Subunit := True; Parsing_Main_Extended_Source := True;
end if; end if;
Discard_List (Par (Configuration_Pragmas => False)); Discard_List (Par (Configuration_Pragmas => False));
Parsing_Main_Subunit := Save_PMS; Parsing_Main_Extended_Source := Save_PMES;
Multiple_Unit_Index := Save_Index; Multiple_Unit_Index := Save_Index;
Set_Loading (Unum, False); Set_Loading (Unum, False);
...@@ -689,7 +695,8 @@ package body Lib.Load is ...@@ -689,7 +695,8 @@ package body Lib.Load is
Error_Msg Error_Msg
("\incorrect spec in file { must be removed first!", ("\incorrect spec in file { must be removed first!",
Load_Msg_Sloc); Load_Msg_Sloc);
return No_Unit; Unum := No_Unit;
goto Done;
end if; end if;
-- If loaded unit had a fatal error, then caller inherits it! -- If loaded unit had a fatal error, then caller inherits it!
...@@ -706,7 +713,7 @@ package body Lib.Load is ...@@ -706,7 +713,7 @@ package body Lib.Load is
-- All done, return unit number -- All done, return unit number
return Unum; goto Done;
-- Case of file not found -- Case of file not found
...@@ -760,9 +767,16 @@ package body Lib.Load is ...@@ -760,9 +767,16 @@ package body Lib.Load is
Units.Decrement_Last; Units.Decrement_Last;
end if; end if;
return No_Unit; Unum := No_Unit;
goto Done;
end if; end if;
end if; end if;
-- Here to exit, with result in Unum
<<Done>>
Parsing_Main_Extended_Source := Save_PMES;
return Unum;
end Load_Unit; end Load_Unit;
-------------------------- --------------------------
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -109,7 +109,8 @@ package Lib.Load is ...@@ -109,7 +109,8 @@ package Lib.Load is
Subunit : Boolean; Subunit : Boolean;
Corr_Body : Unit_Number_Type := No_Unit; Corr_Body : Unit_Number_Type := No_Unit;
Renamings : Boolean := False; Renamings : Boolean := False;
With_Node : Node_Id := Empty) return Unit_Number_Type; With_Node : Node_Id := Empty;
PMES : Boolean := False) return Unit_Number_Type;
-- This function loads and parses the unit specified by Load_Name (or -- This function loads and parses the unit specified by Load_Name (or
-- returns the unit number for the previously constructed units table -- returns the unit number for the previously constructed units table
-- entry if this is not the first call for this unit). Required indicates -- entry if this is not the first call for this unit). Required indicates
...@@ -151,6 +152,9 @@ package Lib.Load is ...@@ -151,6 +152,9 @@ package Lib.Load is
-- With_Node is set to the with_clause or limited_with_clause causing -- With_Node is set to the with_clause or limited_with_clause causing
-- the unit to be loaded, and is used to bypass the circular dependency -- the unit to be loaded, and is used to bypass the circular dependency
-- check in the case of a limited_with_clause (Ada 2005, AI-50217). -- check in the case of a limited_with_clause (Ada 2005, AI-50217).
--
-- PMES indicates the required setting of Parsing_Main_Extended_Unit during
-- loading of the unit. This flag is saved and restored over the call.
procedure Change_Main_Unit_To_Spec; procedure Change_Main_Unit_To_Spec;
-- This procedure is called if the main unit file contains a No_Body pragma -- This procedure is called if the main unit file contains a No_Body pragma
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -701,11 +701,10 @@ package body Lib is ...@@ -701,11 +701,10 @@ package body Lib is
Mloc : constant Source_Ptr := Sloc (Cunit (Main_Unit)); Mloc : constant Source_Ptr := Sloc (Cunit (Main_Unit));
begin begin
-- If Mloc is not set, it means we are still parsing the main unit, -- If parsing, then use the global flag to indicate result
-- so everything so far is in the extended main source unit.
if Mloc = No_Location then if Compiler_State = Parsing then
return True; return Parsing_Main_Extended_Source;
-- Special value cases -- Special value cases
...@@ -741,11 +740,10 @@ package body Lib is ...@@ -741,11 +740,10 @@ package body Lib is
Mloc : constant Source_Ptr := Sloc (Cunit (Main_Unit)); Mloc : constant Source_Ptr := Sloc (Cunit (Main_Unit));
begin begin
-- If Mloc is not set, it means we are still parsing the main unit, -- If parsing, then use the global flag to indicate result
-- so everything so far is in the extended main source unit.
if Mloc = No_Location then if Compiler_State = Parsing then
return True; return Parsing_Main_Extended_Source;
-- Special value cases -- Special value cases
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -39,6 +39,16 @@ with Types; use Types; ...@@ -39,6 +39,16 @@ with Types; use Types;
package Lib is package Lib is
type Compiler_State_Type is (Parsing, Analyzing);
Compiler_State : Compiler_State_Type;
-- Indicates current state of compilation. This is used to implement the
-- function In_Extended_Main_Source_Unit.
Parsing_Main_Extended_Source : Boolean := False;
-- Set True if we are currently parsing a file that is part of the main
-- extended source (the main unit, its spec, or one of its subunits). This
-- flag to implement In_Extended_Main_Source_Unit.
-------------------------------------------- --------------------------------------------
-- General Approach to Library Management -- -- General Approach to Library Management --
-------------------------------------------- --------------------------------------------
......
...@@ -266,7 +266,8 @@ begin ...@@ -266,7 +266,8 @@ begin
Required => False, Required => False,
Subunit => False, Subunit => False,
Error_Node => Curunit, Error_Node => Curunit,
Corr_Body => Cur_Unum); Corr_Body => Cur_Unum,
PMES => (Cur_Unum = Main_Unit));
-- If we successfully load the unit, then set the spec/body pointers. -- If we successfully load the unit, then set the spec/body pointers.
-- Once again note that if the loaded unit has a fatal error, Load will -- Once again note that if the loaded unit has a fatal error, Load will
...@@ -342,25 +343,17 @@ begin ...@@ -342,25 +343,17 @@ begin
-- If current unit is a subunit, then load its parent body -- If current unit is a subunit, then load its parent body
elsif Nkind (Unit (Curunit)) = N_Subunit then elsif Nkind (Unit (Curunit)) = N_Subunit then
declare Body_Name := Get_Parent_Body_Name (Unit_Name (Cur_Unum));
Save_PMS : constant Boolean := Parsing_Main_Subunit; Unum :=
Load_Unit
begin (Load_Name => Body_Name,
Parsing_Main_Subunit := False; Required => True,
Body_Name := Get_Parent_Body_Name (Unit_Name (Cur_Unum)); Subunit => False,
Unum := Error_Node => Name (Unit (Curunit)));
Load_Unit
(Load_Name => Body_Name,
Required => True,
Subunit => False,
Error_Node => Name (Unit (Curunit)));
if Unum /= No_Unit then
Set_Library_Unit (Curunit, Cunit (Unum));
end if;
Parsing_Main_Subunit := Save_PMS; if Unum /= No_Unit then
end; Set_Library_Unit (Curunit, Cunit (Unum));
end if;
end if; end if;
-- Now we load with'ed units, with style/validity checks turned off -- Now we load with'ed units, with style/validity checks turned off
......
...@@ -68,6 +68,7 @@ with Sem_Util; use Sem_Util; ...@@ -68,6 +68,7 @@ with Sem_Util; use Sem_Util;
with Sem_Type; use Sem_Type; with Sem_Type; use Sem_Type;
with Sem_Warn; use Sem_Warn; with Sem_Warn; use Sem_Warn;
with Sinfo; use Sinfo; with Sinfo; use Sinfo;
with Sinfo.CN; use Sinfo.CN;
with Snames; use Snames; with Snames; use Snames;
with Stand; use Stand; with Stand; use Stand;
with Stringt; use Stringt; with Stringt; use Stringt;
...@@ -1065,8 +1066,13 @@ package body Sem_Res is ...@@ -1065,8 +1066,13 @@ package body Sem_Res is
-- Rewrite as call if overloadable entity that is (or could be, in the -- Rewrite as call if overloadable entity that is (or could be, in the
-- overloaded case) a function call. If we know for sure that the entity -- overloaded case) a function call. If we know for sure that the entity
-- is an enumeration literal, we do not rewrite it. -- is an enumeration literal, we do not rewrite it.
-- If the entity is the name of an operator, it cannot be a call because
-- operators cannot have default parameters. In this case, this must be
-- a string whose contents coincide with an operator name. Set the kind
-- of the node appropriately and reanalyze.
if (Is_Entity_Name (N) if (Is_Entity_Name (N)
and then Nkind (N) /= N_Operator_Symbol
and then Is_Overloadable (Entity (N)) and then Is_Overloadable (Entity (N))
and then (Ekind (Entity (N)) /= E_Enumeration_Literal and then (Ekind (Entity (N)) /= E_Enumeration_Literal
or else Is_Overloaded (N))) or else Is_Overloaded (N)))
...@@ -1115,6 +1121,11 @@ package body Sem_Res is ...@@ -1115,6 +1121,11 @@ package body Sem_Res is
elsif Nkind (N) = N_Parameter_Association then elsif Nkind (N) = N_Parameter_Association then
Check_Parameterless_Call (Explicit_Actual_Parameter (N)); Check_Parameterless_Call (Explicit_Actual_Parameter (N));
elsif Nkind (N) = N_Operator_Symbol then
Change_Operator_Symbol_To_String_Literal (N);
Set_Is_Overloaded (N, False);
Set_Etype (N, Any_String);
end if; end if;
end Check_Parameterless_Call; end Check_Parameterless_Call;
......
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