OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes]

Browse Source 
2010-10-04  Robert Dewar  <dewar@adacore.com>

	* sem_ch13.adb (Set_Biased): New procedure, now used throughout, adds
	name of entity to biased warning msg.
	(Analyze_Enumeration_Representation_Clause): Remove attempt to use
	biased rep (wrong and never worked anyway).

2010-10-04  Arnaud Charlet  <charlet@adacore.com>

	* sem_elab.adb: Minor reformatting.

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

	* exp_ch4.adb (Expand_N_Null): Handle properly the case of a subtype of
	an access_to_protected subprogram type, and convert null value into
	corresponding aggregate.

2010-10-04  Eric Botcazou  <ebotcazou@adacore.com>

	* gnat_ugn.texi: Clarify first point of 7.1.5 about pragma Inline.

2010-10-04  Eric Botcazou  <ebotcazou@adacore.com>

	* make.adb (Scan_Make_Arg): Pass -Oxxx switches to the linker as well.
	* gnatlink.adb (Gnatlink): Filter out -Oxxx switches for CLI, RTX and
	AAMP.

2010-10-04  Eric Botcazou  <ebotcazou@adacore.com>

	* sem_ch4.adb (Analyze_Indexed_Component_Form): Remove redundant test
	for N_Operator_Symbol.
	(Indicate_Name_And_Type): Likewise.
	* sem_ch8.adb (Analyze_Subprogram_Renaming): Likewise.
	* sem_res.adb (Resolve): Likewise.
	* sem_type.adb (Add_One_Interp): Likewise.
	(Disambiguate): Likewise.
	
2010-10-04  Vincent Celier  <celier@adacore.com>

	* osint.adb (Read_Library_Info_From_Full): If object timestamp is less
	than ALI file timestamp, return null.

2010-10-04  Vincent Celier  <celier@adacore.com>

	* prj-makr.adb (Finalize): Invoke Pretty_Print with Max_Length set to 79
	* prj-pp.adb (Pretty_Print): New parameter Max_Line_Length, that
	replaces global constant with the same name. When a line is too long,
	indent properly the next continuation line.
	* prj-pp.ads (Pretty_Print): New parameter Max_Line_Length with a range
	from 50 to 255, defaulted to 255, to indicate the maximum length of
	lines in the project file.

2010-10-04  Eric Botcazou  <ebotcazou@adacore.com>

	* sem_ch7.adb (Analyze_Package_Body_Helper) <Has_Referencer>: New
	Check_Subprogram_Ref function and Check_Subprogram_Refs instantiation
	of Traverse_Func on it to look for subprogram references in a body.
	Call Check_Subprogram_Refs on the body of inlined subprograms at the
	outer level and keep clearing the Is_Public flag of subprograms as long
	as it returns OK.  Do not look at anything else than subprograms once
	an inlined subprogram has been seen.

From-SVN: r164940
This commit is contained in:
Arnaud Charlet 2010-10-04 16:09:52 +02:00
parent d69cf005d0
commit a3f2babd42
15 changed files with 471 additions and 230 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

62
gcc/ada/ChangeLog
View File

@ -1,3 +1,65 @@
2010-10-04 Robert Dewar <dewar@adacore.com>
* sem_ch13.adb (Set_Biased): New procedure, now used throughout, adds
name of entity to biased warning msg.
(Analyze_Enumeration_Representation_Clause): Remove attempt to use
biased rep (wrong and never worked anyway).
2010-10-04 Arnaud Charlet <charlet@adacore.com>
* sem_elab.adb: Minor reformatting.
2010-10-04 Ed Schonberg <schonberg@adacore.com>
* exp_ch4.adb (Expand_N_Null): Handle properly the case of a subtype of
an access_to_protected subprogram type, and convert null value into
corresponding aggregate.
2010-10-04 Eric Botcazou <ebotcazou@adacore.com>
* gnat_ugn.texi: Clarify first point of 7.1.5 about pragma Inline.
2010-10-04 Eric Botcazou <ebotcazou@adacore.com>
* make.adb (Scan_Make_Arg): Pass -Oxxx switches to the linker as well.
* gnatlink.adb (Gnatlink): Filter out -Oxxx switches for CLI, RTX and
AAMP.
2010-10-04 Eric Botcazou <ebotcazou@adacore.com>
* sem_ch4.adb (Analyze_Indexed_Component_Form): Remove redundant test
for N_Operator_Symbol.
(Indicate_Name_And_Type): Likewise.
* sem_ch8.adb (Analyze_Subprogram_Renaming): Likewise.
* sem_res.adb (Resolve): Likewise.
* sem_type.adb (Add_One_Interp): Likewise.
(Disambiguate): Likewise.
2010-10-04 Vincent Celier <celier@adacore.com>
* osint.adb (Read_Library_Info_From_Full): If object timestamp is less
than ALI file timestamp, return null.
2010-10-04 Vincent Celier <celier@adacore.com>
* prj-makr.adb (Finalize): Invoke Pretty_Print with Max_Length set to 79
* prj-pp.adb (Pretty_Print): New parameter Max_Line_Length, that
replaces global constant with the same name. When a line is too long,
indent properly the next continuation line.
* prj-pp.ads (Pretty_Print): New parameter Max_Line_Length with a range
from 50 to 255, defaulted to 255, to indicate the maximum length of
lines in the project file.
2010-10-04 Eric Botcazou <ebotcazou@adacore.com>
* sem_ch7.adb (Analyze_Package_Body_Helper) <Has_Referencer>: New
Check_Subprogram_Ref function and Check_Subprogram_Refs instantiation
of Traverse_Func on it to look for subprogram references in a body.
Call Check_Subprogram_Refs on the body of inlined subprograms at the
outer level and keep clearing the Is_Public flag of subprograms as long
as it returns OK. Do not look at anything else than subprograms once
an inlined subprogram has been seen.
2010-10-04 Javier Miranda <miranda@adacore.com>
* exp_cg.adb (Expand_N_Assignment_Statement): Restore tag check when

19
gcc/ada/exp_ch4.adb
View File

@ -2183,7 +2183,7 @@ package body Exp_Ch4 is
-- if no TSS has been created for the type, check whether there is
-- a primitive equality declared for it. If it is abstract replace
-- the call with an explicit raise.
-- the call with an explicit raise (AI05-0123).
declare
Prim : Elmt_Id;
@ -2208,7 +2208,7 @@ package body Exp_Ch4 is
end loop;
end;
-- Predfined equality applies iff no user-defined primitive exists
-- Use predefined equality iff no user-defined primitive exists
return Make_Op_Eq (Loc, Lhs, Rhs);
@ -2217,8 +2217,7 @@ package body Exp_Ch4 is
end if;
else
-- It can be a simple record or the full view of a scalar private
-- If not array or record type, it is predefined equality.
return Make_Op_Eq (Loc, Left_Opnd => Lhs, Right_Opnd => Rhs);
end if;
@ -5031,15 +5030,15 @@ package body Exp_Ch4 is
-- Expand_N_Null --
-------------------
-- The only replacement required is for the case of a null of type that is
-- an access to protected subprogram. We represent such access values as a
-- record, and so we must replace the occurrence of null by the equivalent
-- record (with a null address and a null pointer in it), so that the
-- backend creates the proper value.
-- The only replacement required is for the case of a null of a type that
-- is an access to protected subprogram, or a subtype thereof. We represent
-- such access values as a record, and so we must replace the occurrence of
-- null by the equivalent record (with a null address and a null pointer in
-- it), so that the backend creates the proper value.
procedure Expand_N_Null (N : Node_Id) is
Loc : constant Source_Ptr := Sloc (N);
Typ : constant Entity_Id := Etype (N);
Typ : constant Entity_Id := Base_Type (Etype (N));
Agg : Node_Id;
begin

11
gcc/ada/gnat_ugn.texi
View File

@ -4246,7 +4246,7 @@ means that no limit applies.
@item -gnatn
@cindex @option{-gnatn} (@command{gcc})
Activate inlining for subprograms for which
pragma @code{inline} is specified. This inlining is performed
pragma @code{Inline} is specified. This inlining is performed
by the GCC back-end.
@item -gnatN
@ -10392,8 +10392,9 @@ subprograms.
@item
@cindex pragma Inline
@findex Inline
Either @code{pragma Inline} applies to the subprogram, or it is local to
the unit and called once from within it, or it is small and optimization
Either @code{pragma Inline} applies to the subprogram and the
@option{^-gnatn^/INLINE^} switch is used on the command line, or it is local
to the unit and called once from within it, or it is small and optimization
level @option{-O2} is specified, or automatic inlining (optimization level
@option{-O3}) is specified.
@end itemize
@ -10419,9 +10420,7 @@ The call appears in a body (not in a package spec).
There is a @code{pragma Inline} for the subprogram.
@item
@cindex @option{-gnatn} (@command{gcc})
The @option{^-gnatn^/INLINE^} switch
is used in the @command{gcc} command line
The @option{^-gnatn^/INLINE^} switch is used on the command line.
@end itemize
Even if all these conditions are met, it may not be possible for

20
gcc/ada/gnatlink.adb
View File

@ -1965,6 +1965,25 @@ begin
or else Linker_Options.Table (J) (1 .. 2) = "-l"
or else Linker_Options.Table (J) (1 .. 3) = "-Wl"
or else Linker_Options.Table (J) (1 .. 3) = "-sh"
or else Linker_Options.Table (J) (1 .. 2) = "-O"
or else Linker_Options.Table (J) (1 .. 2) = "-g"
then
Linker_Options.Table (J .. Linker_Options.Last - 1) :=
Linker_Options.Table (J + 1 .. Linker_Options.Last);
Linker_Options.Decrement_Last;
Num_Args := Num_Args - 1;
end if;
end loop;
elsif AAMP_On_Target then
-- Remove extraneous flags not relevant for AAMP
for J in reverse Linker_Options.First .. Linker_Options.Last loop
if Linker_Options.Table (J)'Length = 0
or else Linker_Options.Table (J) (1 .. 3) = "-Wl"
or else Linker_Options.Table (J) (1 .. 3) = "-sh"
or else Linker_Options.Table (J) (1 .. 2) = "-O"
or else Linker_Options.Table (J) (1 .. 2) = "-g"
then
Linker_Options.Table (J .. Linker_Options.Last - 1) :=
@ -1986,6 +2005,7 @@ begin
or else Linker_Options.Table (J) (1 .. 2) = "-l"
or else Linker_Options.Table (J) (1 .. 3) = "-Wl"
or else Linker_Options.Table (J) (1 .. 3) = "-sh"
or else Linker_Options.Table (J) (1 .. 2) = "-O"
or else Linker_Options.Table (J) (1 .. 8) = "-Xlinker"
or else Linker_Options.Table (J) (1 .. 9) = "-mthreads"
then

5
gcc/ada/make.adb
View File

@ -8060,12 +8060,12 @@ package body Make is
elsif Argv (2) = 'L' then
Add_Switch (Argv, Linker, And_Save => And_Save);
-- For -gxxxxx, -pg, -mxxx, -fxxx: give the switch to both the
-- For -gxxx, -pg, -mxxx, -fxxx, -Oxxx, pass the switch to both the
-- compiler and the linker (except for -gnatxxx which is only for the
-- compiler). Some of the -mxxx (for example -m64) and -fxxx (for
-- example -ftest-coverage for gcov) need to be used when compiling
-- the binder generated files, and using all these gcc switches for
-- the binder generated files should not be a problem.
-- them should not be a problem. Pass -Oxxx to the linker for LTO.
elsif
(Argv (2) = 'g' and then (Argv'Last < 5
@ -8073,6 +8073,7 @@ package body Make is
or else Argv (2 .. Argv'Last) = "pg"
or else (Argv (2) = 'm' and then Argv'Last > 2)
or else (Argv (2) = 'f' and then Argv'Last > 2)
or else (Argv (2) = 'O' and then Argv'Last > 2)
then
Add_Switch (Argv, Compiler, And_Save => And_Save);
Add_Switch (Argv, Linker, And_Save => And_Save);

7
gcc/ada/osint.adb
View File

@ -2508,6 +2508,13 @@ package body Osint is
return null;
end if;
elsif Current_Full_Obj_Stamp < Current_Full_Lib_Stamp then
Close (Lib_FD, Status);
-- No need to check the status, we return null anyway
return null;
end if;
end if;

3
gcc/ada/prj-makr.adb
View File

@ -693,7 +693,8 @@ package body Prj.Makr is
W_Char => Write_A_Char'Access,
W_Eol => Write_Eol'Access,
W_Str => Write_A_String'Access,
Backward_Compatibility => False);
Backward_Compatibility => False,
Max_Line_Length => 79);
Close (Output_FD);
-- Delete the naming project file if it already exists

334
gcc/ada/prj-pp.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2001-2009, Free Software Foundation, Inc. --
-- Copyright (C) 2001-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- --
@ -34,19 +34,6 @@ package body Prj.PP is
Not_Tested : array (Project_Node_Kind) of Boolean := (others => True);
Max_Line_Length : constant := 255;
-- Maximum length of a line. This is chosen to be compatible with older
-- versions of GNAT that had a strict limit on the maximum line length.
Column : Natural := 0;
-- Column number of the last character in the line. Used to avoid
-- outputting lines longer than Max_Line_Length.
First_With_In_List : Boolean := True;
-- Indicate that the next with clause is first in a list such as
-- with "A", "B";
-- First_With_In_List will be True for "A", but not for "B".
procedure Indicate_Tested (Kind : Project_Node_Kind);
-- Set the corresponding component of array Not_Tested to False.
-- Only called by pragmas Debug.
@ -67,14 +54,16 @@ package body Prj.PP is
procedure Pretty_Print
(Project : Prj.Tree.Project_Node_Id;
In_Tree : Prj.Tree.Project_Node_Tree_Ref;
Increment : Positive := 3;
Eliminate_Empty_Case_Constructions : Boolean := False;
Minimize_Empty_Lines : Boolean := False;
W_Char : Write_Char_Ap := null;
W_Eol : Write_Eol_Ap := null;
W_Str : Write_Str_Ap := null;
Increment : Positive := 3;
Eliminate_Empty_Case_Constructions : Boolean := False;
Minimize_Empty_Lines : Boolean := False;
W_Char : Write_Char_Ap := null;
W_Eol : Write_Eol_Ap := null;
W_Str : Write_Str_Ap := null;
Backward_Compatibility : Boolean;
Id : Prj.Project_Id := Prj.No_Project)
Id : Prj.Project_Id := Prj.No_Project;
Max_Line_Length : Max_Length_Of_Line :=
Max_Length_Of_Line'Last)
is
procedure Print (Node : Project_Node_Id; Indent : Natural);
-- A recursive procedure that traverses a project file tree and outputs
@ -82,28 +71,35 @@ package body Prj.PP is
-- is used when printing attributes, since in nested packages they
-- need to use a fully qualified name.
procedure Output_Attribute_Name (Name : Name_Id);
procedure Output_Attribute_Name (Name : Name_Id; Indent : Natural);
-- Outputs an attribute name, taking into account the value of
-- Backward_Compatibility.
procedure Output_Name (Name : Name_Id; Capitalize : Boolean := True);
procedure Output_Name
(Name : Name_Id;
Indent : Natural;
Capitalize : Boolean := True);
-- Outputs a name
procedure Start_Line (Indent : Natural);
-- Outputs the indentation at the beginning of the line
procedure Output_String (S : Name_Id);
procedure Output_String (S : Path_Name_Type);
procedure Output_String (S : Name_Id; Indent : Natural);
procedure Output_String (S : Path_Name_Type; Indent : Natural);
-- Outputs a string using the default output procedures
procedure Write_Empty_Line (Always : Boolean := False);
-- Outputs an empty line, only if the previous line was not empty
-- already and either Always is True or Minimize_Empty_Lines is False.
-- already and either Always is True or Minimize_Empty_Lines is
-- False.
procedure Write_Line (S : String);
-- Outputs S followed by a new line
procedure Write_String (S : String; Truncated : Boolean := False);
procedure Write_String
(S : String;
Indent : Natural;
Truncated : Boolean := False);
-- Outputs S using Write_Str, starting a new line if line would
-- become too long, when Truncated = False.
-- When Truncated = True, only the part of the string that can fit on
@ -112,39 +108,48 @@ package body Prj.PP is
procedure Write_End_Of_Line_Comment (Node : Project_Node_Id);
Write_Char : Write_Char_Ap := Output.Write_Char'Access;
Write_Eol : Write_Eol_Ap := Output.Write_Eol'Access;
Write_Str : Write_Str_Ap := Output.Write_Str'Access;
Write_Eol : Write_Eol_Ap := Output.Write_Eol'Access;
Write_Str : Write_Str_Ap := Output.Write_Str'Access;
-- These three access to procedure values are used for the output
Last_Line_Is_Empty : Boolean := False;
-- Used to avoid two consecutive empty lines
Column : Natural := 0;
-- Column number of the last character in the line. Used to avoid
-- outputting lines longer than Max_Line_Length.
First_With_In_List : Boolean := True;
-- Indicate that the next with clause is first in a list such as
-- with "A", "B";
-- First_With_In_List will be True for "A", but not for "B".
---------------------------
-- Output_Attribute_Name --
---------------------------
procedure Output_Attribute_Name (Name : Name_Id) is
procedure Output_Attribute_Name (Name : Name_Id; Indent : Natural) is
begin
if Backward_Compatibility then
case Name is
when Snames.Name_Spec =>
Output_Name (Snames.Name_Specification);
Output_Name (Snames.Name_Specification, Indent);
when Snames.Name_Spec_Suffix =>
Output_Name (Snames.Name_Specification_Suffix);
Output_Name (Snames.Name_Specification_Suffix, Indent);
when Snames.Name_Body =>
Output_Name (Snames.Name_Implementation);
Output_Name (Snames.Name_Implementation, Indent);
when Snames.Name_Body_Suffix =>
Output_Name (Snames.Name_Implementation_Suffix);
Output_Name (Snames.Name_Implementation_Suffix, Indent);
when others =>
Output_Name (Name);
Output_Name (Name, Indent);
end case;
else
Output_Name (Name);
Output_Name (Name, Indent);
end if;
end Output_Attribute_Name;
@ -152,10 +157,18 @@ package body Prj.PP is
-- Output_Name --
-----------------
procedure Output_Name (Name : Name_Id; Capitalize : Boolean := True) is
procedure Output_Name
(Name : Name_Id;
Indent : Natural;
Capitalize : Boolean := True)
is
Capital : Boolean := Capitalize;
begin
if Column = 0 and then Indent /= 0 then
Start_Line (Indent + Increment);
end if;
Get_Name_String (Name);
-- If line would become too long, create new line
@ -163,6 +176,10 @@ package body Prj.PP is
if Column + Name_Len > Max_Line_Length then
Write_Eol.all;
Column := 0;
if Indent /= 0 then
Start_Line (Indent + Increment);
end if;
end if;
for J in 1 .. Name_Len loop
@ -186,18 +203,26 @@ package body Prj.PP is
-- Output_String --
-------------------
procedure Output_String (S : Name_Id) is
procedure Output_String (S : Name_Id; Indent : Natural) is
begin
if Column = 0 and then Indent /= 0 then
Start_Line (Indent + Increment);
end if;
Get_Name_String (S);
-- If line could become too long, create new line.
-- Note that the number of characters on the line could be
-- twice the number of character in the string (if every
-- character is a '"') plus two (the initial and final '"').
-- If line could become too long, create new line. Note that the
-- number of characters on the line could be twice the number of
-- character in the string (if every character is a '"') plus two
-- (the initial and final '"').
if Column + Name_Len + Name_Len + 2 > Max_Line_Length then
Write_Eol.all;
Column := 0;
if Indent /= 0 then
Start_Line (Indent + Increment);
end if;
end if;
Write_Char ('"');
@ -214,14 +239,16 @@ package body Prj.PP is
Column := Column + 1;
end if;
-- If the string does not fit on one line, cut it in parts
-- and concatenate.
-- If the string does not fit on one line, cut it in parts and
-- concatenate.
if J < Name_Len and then Column >= Max_Line_Length then
Write_Str (""" &");
Write_Eol.all;
Column := 0;
Start_Line (Indent + Increment);
Write_Char ('"');
Column := 1;
Column := Column + 1;
end if;
end loop;
@ -229,9 +256,9 @@ package body Prj.PP is
Column := Column + 1;
end Output_String;
procedure Output_String (S : Path_Name_Type) is
procedure Output_String (S : Path_Name_Type; Indent : Natural) is
begin
Output_String (Name_Id (S));
Output_String (Name_Id (S), Indent);
end Output_String;
----------------
@ -269,8 +296,8 @@ package body Prj.PP is
begin
if Value /= No_Name then
Write_String (" --");
Write_String (Get_Name_String (Value), Truncated => True);
Write_String (" --", 0);
Write_String (Get_Name_String (Value), 0, Truncated => True);
end if;
Write_Line ("");
@ -282,7 +309,7 @@ package body Prj.PP is
procedure Write_Line (S : String) is
begin
Write_String (S);
Write_String (S, 0);
Last_Line_Is_Empty := False;
Write_Eol.all;
Column := 0;
@ -292,9 +319,16 @@ package body Prj.PP is
-- Write_String --
------------------
procedure Write_String (S : String; Truncated : Boolean := False) is
procedure Write_String
(S : String;
Indent : Natural;
Truncated : Boolean := False) is
Length : Natural := S'Length;
begin
if Column = 0 and then Indent /= 0 then
Start_Line (Indent + Increment);
end if;
-- If the string would not fit on the line,
-- start a new line.
@ -305,6 +339,10 @@ package body Prj.PP is
else
Write_Eol.all;
Column := 0;
if Indent /= 0 then
Start_Line (Indent + Increment);
end if;
end if;
end if;
@ -316,7 +354,7 @@ package body Prj.PP is
-- Print --
-----------
procedure Print (Node : Project_Node_Id; Indent : Natural) is
procedure Print (Node : Project_Node_Id; Indent : Natural) is
begin
if Present (Node) then
@ -335,27 +373,29 @@ package body Prj.PP is
Print (First_Comment_Before (Node, In_Tree), Indent);
Start_Line (Indent);
Write_String ("project ");
Write_String ("project ", Indent);
if Id /= Prj.No_Project then
Output_Name (Id.Display_Name);
Output_Name (Id.Display_Name, Indent);
else
Output_Name (Name_Of (Node, In_Tree));
Output_Name (Name_Of (Node, In_Tree), Indent);
end if;
-- Check if this project extends another project
if Extended_Project_Path_Of (Node, In_Tree) /= No_Path then
Write_String (" extends ");
Write_String (" extends ", Indent);
if Is_Extending_All (Node, In_Tree) then
Write_String ("all ");
Write_String ("all ", Indent);
end if;
Output_String (Extended_Project_Path_Of (Node, In_Tree));
Output_String
(Extended_Project_Path_Of (Node, In_Tree),
Indent);
end if;
Write_String (" is");
Write_String (" is", Indent);
Write_End_Of_Line_Comment (Node);
Print
(First_Comment_After (Node, In_Tree), Indent + Increment);
@ -368,12 +408,12 @@ package body Prj.PP is
(First_Comment_Before_End (Node, In_Tree),
Indent + Increment);
Start_Line (Indent);
Write_String ("end ");
Write_String ("end ", Indent);
if Id /= Prj.No_Project then
Output_Name (Id.Display_Name);
Output_Name (Id.Display_Name, Indent);
else
Output_Name (Name_Of (Node, In_Tree));
Output_Name (Name_Of (Node, In_Tree), Indent);
end if;
Write_Line (";");
@ -397,20 +437,20 @@ package body Prj.PP is
if Non_Limited_Project_Node_Of (Node, In_Tree) =
Empty_Node
then
Write_String ("limited ");
Write_String ("limited ", Indent);
end if;
Write_String ("with ");
Write_String ("with ", Indent);
end if;
Output_String (String_Value_Of (Node, In_Tree));
Output_String (String_Value_Of (Node, In_Tree), Indent);
if Is_Not_Last_In_List (Node, In_Tree) then
Write_String (", ");
Write_String (", ", Indent);
First_With_In_List := False;
else
Write_String (";");
Write_String (";", Indent);
Write_End_Of_Line_Comment (Node);
Print (First_Comment_After (Node, In_Tree), Indent);
First_With_In_List := True;
@ -441,25 +481,26 @@ package body Prj.PP is
Write_Empty_Line (Always => True);
Print (First_Comment_Before (Node, In_Tree), Indent);
Start_Line (Indent);
Write_String ("package ");
Output_Name (Name_Of (Node, In_Tree));
Write_String ("package ", Indent);
Output_Name (Name_Of (Node, In_Tree), Indent);
if Project_Of_Renamed_Package_Of (Node, In_Tree) /=
Empty_Node
then
Write_String (" renames ");
Write_String (" renames ", Indent);
Output_Name
(Name_Of
(Project_Of_Renamed_Package_Of (Node, In_Tree),
In_Tree));
Write_String (".");
Output_Name (Name_Of (Node, In_Tree));
Write_String (";");
In_Tree),
Indent);
Write_String (".", Indent);
Output_Name (Name_Of (Node, In_Tree), Indent);
Write_String (";", Indent);
Write_End_Of_Line_Comment (Node);
Print (First_Comment_After_End (Node, In_Tree), Indent);
else
Write_String (" is");
Write_String (" is", Indent);
Write_End_Of_Line_Comment (Node);
Print (First_Comment_After (Node, In_Tree),
Indent + Increment);
@ -475,8 +516,8 @@ package body Prj.PP is
Print (First_Comment_Before_End (Node, In_Tree),
Indent + Increment);
Start_Line (Indent);
Write_String ("end ");
Output_Name (Name_Of (Node, In_Tree));
Write_String ("end ", Indent);
Output_Name (Name_Of (Node, In_Tree), Indent);
Write_Line (";");
Print (First_Comment_After_End (Node, In_Tree), Indent);
Write_Empty_Line;
@ -486,11 +527,11 @@ package body Prj.PP is
pragma Debug (Indicate_Tested (N_String_Type_Declaration));
Print (First_Comment_Before (Node, In_Tree), Indent);
Start_Line (Indent);
Write_String ("type ");
Output_Name (Name_Of (Node, In_Tree));
Write_String ("type ", Indent);
Output_Name (Name_Of (Node, In_Tree), Indent);
Write_Line (" is");
Start_Line (Indent + Increment);
Write_String ("(");
Write_String ("(", Indent);
declare
String_Node : Project_Node_Id :=
@ -498,50 +539,57 @@ package body Prj.PP is
begin
while Present (String_Node) loop
Output_String (String_Value_Of (String_Node, In_Tree));
Output_String
(String_Value_Of (String_Node, In_Tree),
Indent);
String_Node :=
Next_Literal_String (String_Node, In_Tree);
if Present (String_Node) then
Write_String (", ");
Write_String (", ", Indent);
end if;
end loop;
end;
Write_String (");");
Write_String (");", Indent);
Write_End_Of_Line_Comment (Node);
Print (First_Comment_After (Node, In_Tree), Indent);
when N_Literal_String =>
pragma Debug (Indicate_Tested (N_Literal_String));
Output_String (String_Value_Of (Node, In_Tree));
Output_String (String_Value_Of (Node, In_Tree), Indent);
if Source_Index_Of (Node, In_Tree) /= 0 then
Write_String (" at");
Write_String (Source_Index_Of (Node, In_Tree)'Img);
Write_String (" at", Indent);
Write_String
(Source_Index_Of (Node, In_Tree)'Img,
Indent);
end if;
when N_Attribute_Declaration =>
pragma Debug (Indicate_Tested (N_Attribute_Declaration));
Print (First_Comment_Before (Node, In_Tree), Indent);
Start_Line (Indent);
Write_String ("for ");
Output_Attribute_Name (Name_Of (Node, In_Tree));
Write_String ("for ", Indent);
Output_Attribute_Name (Name_Of (Node, In_Tree), Indent);
if Associative_Array_Index_Of (Node, In_Tree) /= No_Name then
Write_String (" (");
Write_String (" (", Indent);
Output_String
(Associative_Array_Index_Of (Node, In_Tree));
(Associative_Array_Index_Of (Node, In_Tree),
Indent);
if Source_Index_Of (Node, In_Tree) /= 0 then
Write_String (" at");
Write_String (Source_Index_Of (Node, In_Tree)'Img);
Write_String (" at", Indent);
Write_String
(Source_Index_Of (Node, In_Tree)'Img,
Indent);
end if;
Write_String (")");
Write_String (")", Indent);
end if;
Write_String (" use ");
Write_String (" use ", Indent);
if Present (Expression_Of (Node, In_Tree)) then
Print (Expression_Of (Node, In_Tree), Indent);
@ -555,16 +603,18 @@ package body Prj.PP is
Output_Name
(Name_Of
(Associative_Project_Of (Node, In_Tree),
In_Tree));
In_Tree),
Indent);
if
Present (Associative_Package_Of (Node, In_Tree))
then
Write_String (".");
Write_String (".", Indent);
Output_Name
(Name_Of
(Associative_Package_Of (Node, In_Tree),
In_Tree));
In_Tree),
Indent);
end if;
elsif
@ -573,14 +623,15 @@ package body Prj.PP is
Output_Name
(Name_Of
(Associative_Package_Of (Node, In_Tree),
In_Tree));
In_Tree),
Indent);
end if;
Write_String ("'");
Output_Attribute_Name (Name_Of (Node, In_Tree));
Write_String ("'", Indent);
Output_Attribute_Name (Name_Of (Node, In_Tree), Indent);
end if;
Write_String (";");
Write_String (";", Indent);
Write_End_Of_Line_Comment (Node);
Print (First_Comment_After (Node, In_Tree), Indent);
@ -589,13 +640,14 @@ package body Prj.PP is
(Indicate_Tested (N_Typed_Variable_Declaration));
Print (First_Comment_Before (Node, In_Tree), Indent);
Start_Line (Indent);
Output_Name (Name_Of (Node, In_Tree));
Write_String (" : ");
Output_Name (Name_Of (Node, In_Tree), Indent);
Write_String (" : ", Indent);
Output_Name
(Name_Of (String_Type_Of (Node, In_Tree), In_Tree));
Write_String (" := ");
(Name_Of (String_Type_Of (Node, In_Tree), In_Tree),
Indent);
Write_String (" := ", Indent);
Print (Expression_Of (Node, In_Tree), Indent);
Write_String (";");
Write_String (";", Indent);
Write_End_Of_Line_Comment (Node);
Print (First_Comment_After (Node, In_Tree), Indent);
@ -603,10 +655,10 @@ package body Prj.PP is
pragma Debug (Indicate_Tested (N_Variable_Declaration));
Print (First_Comment_Before (Node, In_Tree), Indent);
Start_Line (Indent);
Output_Name (Name_Of (Node, In_Tree));
Write_String (" := ");
Output_Name (Name_Of (Node, In_Tree), Indent);
Write_String (" := ", Indent);
Print (Expression_Of (Node, In_Tree), Indent);
Write_String (";");
Write_String (";", Indent);
Write_End_Of_Line_Comment (Node);
Print (First_Comment_After (Node, In_Tree), Indent);
@ -621,7 +673,7 @@ package body Prj.PP is
Term := Next_Term (Term, In_Tree);
if Present (Term) then
Write_String (" & ");
Write_String (" & ", Indent);
end if;
end loop;
end;
@ -632,7 +684,7 @@ package body Prj.PP is
when N_Literal_String_List =>
pragma Debug (Indicate_Tested (N_Literal_String_List));
Write_String ("(");
Write_String ("(", Indent);
declare
Expression : Project_Node_Id :=
@ -645,40 +697,42 @@ package body Prj.PP is
Next_Expression_In_List (Expression, In_Tree);
if Present (Expression) then
Write_String (", ");
Write_String (", ", Indent);
end if;
end loop;
end;
Write_String (")");
Write_String (")", Indent);
when N_Variable_Reference =>
pragma Debug (Indicate_Tested (N_Variable_Reference));
if Present (Project_Node_Of (Node, In_Tree)) then
Output_Name
(Name_Of (Project_Node_Of (Node, In_Tree), In_Tree));
Write_String (".");
(Name_Of (Project_Node_Of (Node, In_Tree), In_Tree),
Indent);
Write_String (".", Indent);
end if;
if Present (Package_Node_Of (Node, In_Tree)) then
Output_Name
(Name_Of (Package_Node_Of (Node, In_Tree), In_Tree));
Write_String (".");
(Name_Of (Package_Node_Of (Node, In_Tree), In_Tree),
Indent);
Write_String (".", Indent);
end if;
Output_Name (Name_Of (Node, In_Tree));
Output_Name (Name_Of (Node, In_Tree), Indent);
when N_External_Value =>
pragma Debug (Indicate_Tested (N_External_Value));
Write_String ("external (");
Write_String ("external (", Indent);
Print (External_Reference_Of (Node, In_Tree), Indent);
if Present (External_Default_Of (Node, In_Tree)) then
Write_String (", ");
Write_String (", ", Indent);
Print (External_Default_Of (Node, In_Tree), Indent);
end if;
Write_String (")");
Write_String (")", Indent);
when N_Attribute_Reference =>
pragma Debug (Indicate_Tested (N_Attribute_Reference));
@ -687,24 +741,27 @@ package body Prj.PP is
and then Project_Node_Of (Node, In_Tree) /= Project
then
Output_Name
(Name_Of (Project_Node_Of (Node, In_Tree), In_Tree));
(Name_Of (Project_Node_Of (Node, In_Tree), In_Tree),
Indent);
if Present (Package_Node_Of (Node, In_Tree)) then
Write_String (".");
Write_String (".", Indent);
Output_Name
(Name_Of (Package_Node_Of (Node, In_Tree), In_Tree));
(Name_Of (Package_Node_Of (Node, In_Tree), In_Tree),
Indent);
end if;
elsif Present (Package_Node_Of (Node, In_Tree)) then
Output_Name
(Name_Of (Package_Node_Of (Node, In_Tree), In_Tree));
(Name_Of (Package_Node_Of (Node, In_Tree), In_Tree),
Indent);
else
Write_String ("project");
Write_String ("project", Indent);
end if;
Write_String ("'");
Output_Attribute_Name (Name_Of (Node, In_Tree));
Write_String ("'", Indent);
Output_Attribute_Name (Name_Of (Node, In_Tree), Indent);
declare
Index : constant Name_Id :=
@ -712,9 +769,9 @@ package body Prj.PP is
begin
if Index /= No_Name then
Write_String (" (");
Output_String (Index);
Write_String (")");
Write_String (" (", Indent);
Output_String (Index, Indent);
Write_String (")", Indent);
end if;
end;
@ -743,11 +800,11 @@ package body Prj.PP is
Write_Empty_Line;
Print (First_Comment_Before (Node, In_Tree), Indent);
Start_Line (Indent);
Write_String ("case ");
Write_String ("case ", Indent);
Print
(Case_Variable_Reference_Of (Node, In_Tree),
Indent);
Write_String (" is");
Write_String (" is", Indent);
Write_End_Of_Line_Comment (Node);
Print
(First_Comment_After (Node, In_Tree),
@ -784,10 +841,10 @@ package body Prj.PP is
Write_Empty_Line;
Print (First_Comment_Before (Node, In_Tree), Indent);
Start_Line (Indent);
Write_String ("when ");
Write_String ("when ", Indent);
if No (First_Choice_Of (Node, In_Tree)) then
Write_String ("others");
Write_String ("others", Indent);
else
declare
@ -799,13 +856,13 @@ package body Prj.PP is
Label := Next_Literal_String (Label, In_Tree);
if Present (Label) then
Write_String (" | ");
Write_String (" | ", Indent);
end if;
end loop;
end;
end if;
Write_String (" =>");
Write_String (" =>", Indent);
Write_End_Of_Line_Comment (Node);
Print
(First_Comment_After (Node, In_Tree),
@ -837,9 +894,10 @@ package body Prj.PP is
end if;
Start_Line (Indent);
Write_String ("--");
Write_String ("--", Indent);
Write_String
(Get_Name_String (String_Value_Of (Node, In_Tree)),
Indent,
Truncated => True);
Write_Line ("");

22
gcc/ada/prj-pp.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2001-2008, Free Software Foundation, Inc. --
-- Copyright (C) 2001-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- --
@ -43,17 +43,21 @@ package Prj.PP is
type Write_Str_Ap is access procedure (S : String);
subtype Max_Length_Of_Line is Positive range 50 .. 255;
procedure Pretty_Print
(Project : Prj.Tree.Project_Node_Id;
In_Tree : Prj.Tree.Project_Node_Tree_Ref;
Increment : Positive := 3;
Eliminate_Empty_Case_Constructions : Boolean := False;
Minimize_Empty_Lines : Boolean := False;
W_Char : Write_Char_Ap := null;
W_Eol : Write_Eol_Ap := null;
W_Str : Write_Str_Ap := null;
Increment : Positive := 3;
Eliminate_Empty_Case_Constructions : Boolean := False;
Minimize_Empty_Lines : Boolean := False;
W_Char : Write_Char_Ap := null;
W_Eol : Write_Eol_Ap := null;
W_Str : Write_Str_Ap := null;
Backward_Compatibility : Boolean;
Id : Prj.Project_Id := Prj.No_Project);
Id : Prj.Project_Id := Prj.No_Project;
Max_Line_Length : Max_Length_Of_Line :=
Max_Length_Of_Line'Last);
-- Output a project file, using either the default output routines, or the
-- ones specified by W_Char, W_Eol and W_Str.
--
@ -77,6 +81,8 @@ package Prj.PP is
--
-- Id is used to compute the display name of the project including its
-- proper casing.
--
-- Max_Line_Length is the maximum line length in the project file.
private

70
gcc/ada/sem_ch13.adb
View File

@ -106,6 +106,16 @@ package body Sem_Ch13 is
-- renaming_as_body. For tagged types, the specification is one of the
-- primitive specs.
procedure Set_Biased
(E : Entity_Id;
N : Node_Id;
Msg : String;
Biased : Boolean := True);
-- If Biased is True, sets Has_Biased_Representation flag for E, and
-- outputs a warning message at node N if Warn_On_Biased_Representation is
-- is True. This warning inserts the string Msg to describe the construct
-- causing biasing.
----------------------------------------------
-- Table for Validate_Unchecked_Conversions --
----------------------------------------------
@ -1342,17 +1352,11 @@ package body Sem_Ch13 is
Set_Esize (New_Ctyp, Csize);
Set_RM_Size (New_Ctyp, Csize);
Init_Alignment (New_Ctyp);
Set_Has_Biased_Representation (New_Ctyp, True);
Set_Is_Itype (New_Ctyp, True);
Set_Associated_Node_For_Itype (New_Ctyp, U_Ent);
Set_Component_Type (Btype, New_Ctyp);
if Warn_On_Biased_Representation then
Error_Msg_N
("?component size clause forces biased "
& "representation", N);
end if;
Set_Biased (New_Ctyp, N, "component size clause");
end if;
Set_Component_Size (Btype, Csize);
@ -1574,12 +1578,7 @@ package body Sem_Ch13 is
or else Has_Small_Clause (U_Ent)
then
Check_Size (Expr, Etyp, Size, Biased);
Set_Has_Biased_Representation (U_Ent, Biased);
if Biased and Warn_On_Biased_Representation then
Error_Msg_N
("?size clause forces biased representation", N);
end if;
Set_Biased (U_Ent, N, "size clause", Biased);
end if;
-- For types set RM_Size and Esize if possible
@ -1953,12 +1952,7 @@ package body Sem_Ch13 is
else
if Is_Elementary_Type (U_Ent) then
Check_Size (Expr, U_Ent, Size, Biased);
Set_Has_Biased_Representation (U_Ent, Biased);
if Biased and Warn_On_Biased_Representation then
Error_Msg_N
("?value size clause forces biased representation", N);
end if;
Set_Biased (U_Ent, N, "value size clause", Biased);
end if;
Set_RM_Size (U_Ent, Size);
@ -2362,7 +2356,8 @@ package body Sem_Ch13 is
-- If biasing worked, indicate that we now have biased rep
else
Set_Has_Biased_Representation (Enumtype);
Set_Biased
(Enumtype, Size_Clause (Enumtype), "size clause");
end if;
end if;
@ -2807,13 +2802,8 @@ package body Sem_Ch13 is
Esize (Comp),
Biased);
Set_Has_Biased_Representation (Comp, Biased);
if Biased and Warn_On_Biased_Representation then
Error_Msg_F
("?component clause forces biased "
& "representation", CC);
end if;
Set_Biased
(Comp, First_Node (CC), "component clause", Biased);
if Present (Ocomp) then
Set_Component_Clause (Ocomp, CC);
@ -2825,6 +2815,10 @@ package body Sem_Ch13 is
Set_Normalized_Position_Max
(Ocomp, Normalized_Position (Ocomp));
-- Note: we don't use Set_Biased here, because we
-- already gave a warning above if needed, and we
-- would get a duplicate for the same name here.
Set_Has_Biased_Representation
(Ocomp, Has_Biased_Representation (Comp));
end if;
@ -4856,7 +4850,6 @@ package body Sem_Ch13 is
-- cases were already dealt with.
elsif Is_Enumeration_Type (T1) then
Enumeration_Case : declare
L1, L2 : Entity_Id;
@ -4884,6 +4877,27 @@ package body Sem_Ch13 is
end if;
end Same_Representation;
----------------
-- Set_Biased --
----------------
procedure Set_Biased
(E : Entity_Id;
N : Node_Id;
Msg : String;
Biased : Boolean := True)
is
begin
if Biased then
Set_Has_Biased_Representation (E);
if Warn_On_Biased_Representation then
Error_Msg_NE
("?" & Msg & " forces biased representation for&", N, E);
end if;
end if;
end Set_Biased;
--------------------
-- Set_Enum_Esize --
--------------------

8
gcc/ada/sem_ch4.adb
View File

@ -2103,9 +2103,7 @@ package body Sem_Ch4 is
P_T := Base_Type (Etype (P));
if Is_Entity_Name (P)
or else Nkind (P) = N_Operator_Symbol
then
if Is_Entity_Name (P) then
U_N := Entity (P);
if Is_Type (U_N) then
@ -2526,9 +2524,7 @@ package body Sem_Ch4 is
-- being called is noted on the selector.
if not Is_Type (Nam) then
if Is_Entity_Name (Name (N))
or else Nkind (Name (N)) = N_Operator_Symbol
then
if Is_Entity_Name (Name (N)) then
Set_Entity (Name (N), Nam);
elsif Nkind (Name (N)) = N_Selected_Component then

127
gcc/ada/sem_ch7.adb
View File

@ -52,6 +52,7 @@ with Sem_Ch8; use Sem_Ch8;
with Sem_Ch10; use Sem_Ch10;
with Sem_Ch12; use Sem_Ch12;
with Sem_Disp; use Sem_Disp;
with Sem_Eval; use Sem_Eval;
with Sem_Prag; use Sem_Prag;
with Sem_Util; use Sem_Util;
with Sem_Warn; use Sem_Warn;
@ -473,9 +474,10 @@ package body Sem_Ch7 is
-- is conservative and definitely correct.
-- We only do this at the outer (library) level non-generic packages.
-- The reason is simply to cut down on the number of external symbols
-- generated, so this is simply an optimization of the efficiency
-- of the compilation process. It has no other effect.
-- The reason is simply to cut down on the number of global symbols
-- generated, which has a double effect: (1) to make the compilation
-- process more efficient and (2) to give the code generator more
-- freedom to optimize within each unit, especially subprograms.
if (Scope (Spec_Id) = Standard_Standard or else Is_Child_Unit (Spec_Id))
and then not Is_Generic_Unit (Spec_Id)
@ -488,16 +490,18 @@ package body Sem_Ch7 is
Outer : Boolean)
return Boolean;
-- Traverse the given list of declarations in reverse order.
-- Return True as soon as a referencer is reached. Return False if
-- none is found. The Outer parameter is True for the outer level
-- call, and False for inner level calls for nested packages. If
-- Outer is True, then any entities up to the point of hitting a
-- referencer get their Is_Public flag cleared, so that the
-- entities will be treated as static entities in the C sense, and
-- need not have fully qualified names. For inner levels, we need
-- all names to be fully qualified to deal with the same name
-- appearing in parallel packages (right now this is tied to their
-- being external).
-- Return True if a referencer is present. Return False if none is
-- found. The Outer parameter is True for the outer level call and
-- False for inner level calls for nested packages. If Outer is
-- True, then any entities up to the point of hitting a referencer
-- get their Is_Public flag cleared, so that the entities will be
-- treated as static entities in the C sense, and need not have
-- fully qualified names. Furthermore, if the referencer is an
-- inlined subprogram that doesn't reference other subprograms,
-- we keep clearing the Is_Public flag on subprograms. For inner
-- levels, we need all names to be fully qualified to deal with
-- the same name appearing in parallel packages (right now this
-- is tied to their being external).
--------------------
-- Has_Referencer --
@ -508,11 +512,66 @@ package body Sem_Ch7 is
Outer : Boolean)
return Boolean
is
Has_Referencer_Except_For_Subprograms : Boolean := False;
D : Node_Id;
E : Entity_Id;
K : Node_Kind;
S : Entity_Id;
function Check_Subprogram_Ref (N : Node_Id)
return Traverse_Result;
-- Look for references to subprograms
--------------------------
-- Check_Subprogram_Ref --
--------------------------
function Check_Subprogram_Ref (N : Node_Id)
return Traverse_Result
is
V : Node_Id;
begin
-- Check name of procedure or function calls
if Nkind_In (N, N_Procedure_Call_Statement, N_Function_Call)
and then Is_Entity_Name (Name (N))
then
return Abandon;
end if;
-- Check prefix of attribute references
if Nkind (N) = N_Attribute_Reference
and then Is_Entity_Name (Prefix (N))
and then Present (Entity (Prefix (N)))
and then Ekind (Entity (Prefix (N))) in Subprogram_Kind
then
return Abandon;
end if;
-- Check value of constants
if Nkind (N) = N_Identifier
and then Present (Entity (N))
and then Ekind (Entity (N)) = E_Constant
then
V := Constant_Value (Entity (N));
if Present (V)
and then not Compile_Time_Known_Value_Or_Aggr (V)
then
return Abandon;
end if;
end if;
return OK;
end Check_Subprogram_Ref;
function Check_Subprogram_Refs is
new Traverse_Func (Check_Subprogram_Ref);
begin
if No (L) then
return False;
@ -525,6 +584,8 @@ package body Sem_Ch7 is
if K in N_Body_Stub then
return True;
-- Processing for subprogram bodies
elsif K = N_Subprogram_Body then
if Acts_As_Spec (D) then
E := Defining_Entity (D);
@ -541,7 +602,13 @@ package body Sem_Ch7 is
-- of accessing global entities.
if Has_Pragma_Inline (E) then
return True;
if Outer
and then Check_Subprogram_Refs (D) = OK
then
Has_Referencer_Except_For_Subprograms := True;
else
return True;
end if;
else
Set_Is_Public (E, False);
end if;
@ -549,18 +616,30 @@ package body Sem_Ch7 is
else
E := Corresponding_Spec (D);
if Present (E)
and then (Is_Generic_Unit (E)
or else Has_Pragma_Inline (E)
or else Is_Inlined (E))
then
return True;
if Present (E) then
-- A generic subprogram body acts as a referencer
if Is_Generic_Unit (E) then
return True;
end if;
if Has_Pragma_Inline (E) or else Is_Inlined (E) then
if Outer
and then Check_Subprogram_Refs (D) = OK
then
Has_Referencer_Except_For_Subprograms := True;
else
return True;
end if;
end if;
end if;
end if;
-- Processing for package bodies
elsif K = N_Package_Body
and then not Has_Referencer_Except_For_Subprograms
and then Present (Corresponding_Spec (D))
then
E := Corresponding_Spec (D);
@ -590,7 +669,9 @@ package body Sem_Ch7 is
-- Processing for package specs, recurse into declarations.
-- Again we skip this for the case of generic instances.
elsif K = N_Package_Declaration then
elsif K = N_Package_Declaration
and then not Has_Referencer_Except_For_Subprograms
then
S := Specification (D);
if not Is_Generic_Unit (Defining_Entity (S)) then
@ -617,6 +698,8 @@ package body Sem_Ch7 is
E := Defining_Entity (D);
if Outer
and then (not Has_Referencer_Except_For_Subprograms
or else K = N_Subprogram_Declaration)
and then not Is_Imported (E)
and then not Is_Exported (E)
and then No (Interface_Name (E))
@ -628,7 +711,7 @@ package body Sem_Ch7 is
Prev (D);
end loop;
return False;
return Has_Referencer_Except_For_Subprograms;
end Has_Referencer;
-- Start of processing for Make_Non_Public_Where_Possible

3
gcc/ada/sem_ch8.adb
View File

@ -2078,8 +2078,7 @@ package body Sem_Ch8 is
Analyze_Renamed_Character (N, New_S, Present (Rename_Spec));
return;
elsif (not Is_Entity_Name (Nam)
and then Nkind (Nam) /= N_Operator_Symbol)
elsif not Is_Entity_Name (Nam)
or else not Is_Overloadable (Entity (Nam))
then
Error_Msg_N ("expect valid subprogram name in renaming", N);

3
gcc/ada/sem_res.adb
View File

@ -2290,8 +2290,7 @@ package body Sem_Res is
-- and also the entity pointer for the prefix.
elsif Nkind_In (N, N_Procedure_Call_Statement, N_Function_Call)
and then (Is_Entity_Name (Name (N))
or else Nkind (Name (N)) = N_Operator_Symbol)
and then Is_Entity_Name (Name (N))
then
Set_Etype (Name (N), Expr_Type);
Set_Entity (Name (N), Seen);

7
gcc/ada/sem_type.adb
View File

@ -482,8 +482,7 @@ package body Sem_Type is
elsif (Nkind (N) = N_Function_Call
or else Nkind (N) = N_Procedure_Call_Statement)
and then (Nkind (Name (N)) = N_Operator_Symbol
or else Is_Entity_Name (Name (N)))
and then Is_Entity_Name (Name (N))
then
Add_Entry (Entity (Name (N)), Etype (N));
@ -1622,9 +1621,7 @@ package body Sem_Type is
Arg1 := Left_Opnd (N);
Arg2 := Right_Opnd (N);
elsif Is_Entity_Name (N)
or else Nkind (N) = N_Operator_Symbol
then
elsif Is_Entity_Name (N) then
Arg1 := First_Entity (Entity (N));
Arg2 := Next_Entity (Arg1);