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.
2010-09-10 Robert Dewar <dewar@adacore.com>
-- If the flag location is in the main extended source unit then for
-- sure we want the warning since it definitely belongs
- if Parsing_Main_Subunit
- or else In_Extended_Main_Source_Unit (Sptr)
- then
+ if In_Extended_Main_Source_Unit (Sptr) then
null;
-- If the flag location is not in the main extended source unit, then
is
begin
if Eflag
- and then (Parsing_Main_Subunit
- or else In_Extended_Main_Source_Unit (N))
+ and then In_Extended_Main_Source_Unit (N)
and then Comes_From_Source (N)
then
Error_Msg_NEL (Msg, N, N, Sloc (N));
-- the use of constructs not permitted by the library in use, or improper
-- 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
renames Err_Vars.Current_Error_Source_File;
-- Id of current messages. Used to post file name when unit changes. This
begin
Write_Str ("edge: { sourcename: ");
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));
if Nkind (P) = N_Package_Declaration then
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
return;
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
declare
Optimize_Alignment := 'T';
end if;
- -- We have now processed the command line switches, and the gnat.adc
- -- file, so this is the point at which we want to capture the values
- -- of the configuration switches (see Opt for further details).
+ -- We have now processed the command line switches, and the configuration
+ -- pragma files, so this is the point at which we want to capture the
+ -- values of the configuration switches (see Opt for further details).
Opt.Register_Opt_Config_Switches;
-- semantics in any case).
Discard_List (Par (Configuration_Pragmas => False));
+ Parsing_Main_Extended_Source := False;
-- The main unit is now loaded, and subunits of it can be loaded,
-- without reporting spurious loading circularities.
Subunit : Boolean;
Corr_Body : Unit_Number_Type := No_Unit;
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
Calling_Unit : Unit_Number_Type;
Uname_Actual : Unit_Name_Type;
Unump : Unit_Number_Type;
Fname : File_Name_Type;
Src_Ind : Source_File_Index;
-
- -- Start of processing for Load_Unit
+ Save_PMES : constant Boolean := Parsing_Main_Extended_Source;
begin
+ Parsing_Main_Extended_Source := PMES;
+
-- 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.
-- Retain the with_clause that names the child, so that if it is
With_Node => With_Node);
if Unump = No_Unit then
+ Parsing_Main_Extended_Source := Save_PMES;
return No_Unit;
end if;
end if;
Write_Dependency_Chain;
- return No_Unit;
+ Unum := No_Unit;
+ goto Done;
else
- return No_Unit;
+ Unum := No_Unit;
+ goto Done;
end if;
end if;
end loop;
Load_Stack.Decrement_Last;
end if;
- return No_Unit;
+ Unum := No_Unit;
+ goto Done;
end if;
if Debug_Flag_L then
end if;
Load_Stack.Decrement_Last;
- return Unum;
+ goto Done;
-- Unit is not already in table, so try to open the file
declare
Save_Index : constant Nat := Multiple_Unit_Index;
- Save_PMS : constant Boolean := Parsing_Main_Subunit;
+ Save_PMES : constant Boolean := Parsing_Main_Extended_Source;
begin
Multiple_Unit_Index := Get_Unit_Index (Uname_Actual);
Initialize_Scanner (Unum, Source_Index (Unum));
if Calling_Unit = Main_Unit and then Subunit then
- Parsing_Main_Subunit := True;
+ Parsing_Main_Extended_Source := True;
end if;
Discard_List (Par (Configuration_Pragmas => False));
- Parsing_Main_Subunit := Save_PMS;
+ Parsing_Main_Extended_Source := Save_PMES;
Multiple_Unit_Index := Save_Index;
Set_Loading (Unum, False);
Error_Msg
("\incorrect spec in file { must be removed first!",
Load_Msg_Sloc);
- return No_Unit;
+ Unum := No_Unit;
+ goto Done;
end if;
-- If loaded unit had a fatal error, then caller inherits it!
-- All done, return unit number
- return Unum;
+ goto Done;
-- Case of file not found
Units.Decrement_Last;
end if;
- return No_Unit;
+ Unum := No_Unit;
+ goto Done;
end if;
end if;
+
+ -- Here to exit, with result in Unum
+
+ <<Done>>
+ Parsing_Main_Extended_Source := Save_PMES;
+ return Unum;
end Load_Unit;
--------------------------
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
Subunit : Boolean;
Corr_Body : Unit_Number_Type := No_Unit;
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
-- returns the unit number for the previously constructed units table
-- entry if this is not the first call for this unit). Required indicates
-- 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
-- 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;
-- This procedure is called if the main unit file contains a No_Body pragma
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
Mloc : constant Source_Ptr := Sloc (Cunit (Main_Unit));
begin
- -- If Mloc is not set, it means we are still parsing the main unit,
- -- so everything so far is in the extended main source unit.
+ -- If parsing, then use the global flag to indicate result
- if Mloc = No_Location then
- return True;
+ if Compiler_State = Parsing then
+ return Parsing_Main_Extended_Source;
-- Special value cases
Mloc : constant Source_Ptr := Sloc (Cunit (Main_Unit));
begin
- -- If Mloc is not set, it means we are still parsing the main unit,
- -- so everything so far is in the extended main source unit.
+ -- If parsing, then use the global flag to indicate result
- if Mloc = No_Location then
- return True;
+ if Compiler_State = Parsing then
+ return Parsing_Main_Extended_Source;
-- Special value cases
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
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 --
--------------------------------------------
Required => False,
Subunit => False,
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.
-- Once again note that if the loaded unit has a fatal error, Load will
-- If current unit is a subunit, then load its parent body
elsif Nkind (Unit (Curunit)) = N_Subunit then
- declare
- Save_PMS : constant Boolean := Parsing_Main_Subunit;
-
- begin
- Parsing_Main_Subunit := False;
- Body_Name := Get_Parent_Body_Name (Unit_Name (Cur_Unum));
- Unum :=
- 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;
+ Body_Name := Get_Parent_Body_Name (Unit_Name (Cur_Unum));
+ Unum :=
+ Load_Unit
+ (Load_Name => Body_Name,
+ Required => True,
+ Subunit => False,
+ Error_Node => Name (Unit (Curunit)));
- Parsing_Main_Subunit := Save_PMS;
- end;
+ if Unum /= No_Unit then
+ Set_Library_Unit (Curunit, Cunit (Unum));
+ end if;
end if;
-- Now we load with'ed units, with style/validity checks turned off
with Sem_Type; use Sem_Type;
with Sem_Warn; use Sem_Warn;
with Sinfo; use Sinfo;
+with Sinfo.CN; use Sinfo.CN;
with Snames; use Snames;
with Stand; use Stand;
with Stringt; use Stringt;
-- 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
-- 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)
+ and then Nkind (N) /= N_Operator_Symbol
and then Is_Overloadable (Entity (N))
and then (Ekind (Entity (N)) /= E_Enumeration_Literal
or else Is_Overloaded (N)))
elsif Nkind (N) = N_Parameter_Association then
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 Check_Parameterless_Call;
OSDN Git Service
