Skip to content

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

[multiple changes] 

2009-07-28  Emmanuel Briot  <briot@adacore.com>

	* prj.adb, prj.ads (Compute_All_Imported_Projects): Make sure the
	importing project does not end up in the list, in the case of extending
	projects.
	* make.adb, makeutl.adb, makeutl.ads (File_Not_A_Source_Of): Moved to
	makeutl.ads, for better sharing with gprbuild.

2009-07-28  Arnaud Charlet  <charlet@adacore.com>

	* gnat_ugn.texi: Fix typo.

2009-07-28  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch3.adb (Build_Derived_Concurrent_Type): Handle properly a
	derivation that renames some discriminants and constrain others.
	* exp_ch9.adb (Build_Protected_Subprogram_Call): If the type of the
	prefix is a derived untagged type, convert to the root type to conform
	to the signature of the protected operations.

2009-07-28  Robert Dewar  <dewar@adacore.com>

	* sinfo.ads: Update comments.
	* exp_attr.adb: Minor reformatting

From-SVN: r150152
parent 55603e5e
Showing with 344 additions and 159 deletions
gcc/ada/ChangeLog
2009-07-28 Emmanuel Briot <briot@adacore.com>
* prj.adb, prj.ads (Compute_All_Imported_Projects): Make sure the
importing project does not end up in the list, in the case of extending
projects.
* make.adb, makeutl.adb, makeutl.ads (File_Not_A_Source_Of): Moved to
makeutl.ads, for better sharing with gprbuild.
2009-07-28 Arnaud Charlet <charlet@adacore.com>
* gnat_ugn.texi: Fix typo.
2009-07-28 Ed Schonberg <schonberg@adacore.com>
* sem_ch3.adb (Build_Derived_Concurrent_Type): Handle properly a
derivation that renames some discriminants and constrain others.
* exp_ch9.adb (Build_Protected_Subprogram_Call): If the type of the
prefix is a derived untagged type, convert to the root type to conform
to the signature of the protected operations.
2009-07-28 Robert Dewar <dewar@adacore.com>
* sinfo.ads: Update comments.
* exp_attr.adb: Minor reformatting
2009-07-28 Ed Schonberg <schonberg@adacore.com>
* sem_aggr.adb (Get_Value): A named association in a record aggregate
......
gcc/ada/exp_attr.adb
......@@ -358,7 +358,7 @@ package body Exp_Attr is
Sub_Ref :=
Make_Attribute_Reference (Loc,
Prefix => Sub,
Prefix => Sub,
Attribute_Name => Name_Access);
-- We set the type of the access reference to the already generated
......@@ -370,17 +370,13 @@ package body Exp_Attr is
Agg :=
Make_Aggregate (Loc,
Expressions =>
New_List (
Obj_Ref, Sub_Ref));
Expressions => New_List (Obj_Ref, Sub_Ref));
Rewrite (N, Agg);
Analyze_And_Resolve (N, E_T);
-- For subsequent analysis, the node must retain its type.
-- The backend will replace it with the equivalent type where
-- needed.
-- For subsequent analysis, the node must retain its type. The backend
-- will replace it with the equivalent type where needed.
Set_Etype (N, Typ);
end Expand_Access_To_Protected_Op;
......
gcc/ada/exp_ch9.adb
......@@ -3193,6 +3193,18 @@ package body Exp_Ch9 is
Params := New_List;
end if;
-- If the type is an untagged derived type, convert to the root type,
-- which is the one on which the operations are defined.
if Nkind (Rec) = N_Unchecked_Type_Conversion
and then not Is_Tagged_Type (Etype (Rec))
and then Is_Derived_Type (Etype (Rec))
then
Set_Etype (Rec, Root_Type (Etype (Rec)));
Set_Subtype_Mark (Rec,
New_Occurrence_Of (Root_Type (Etype (Rec)), Sloc (N)));
end if;
Prepend (Rec, Params);
if Ekind (Sub) = E_Procedure then
......@@ -4358,8 +4370,8 @@ package body Exp_Ch9 is
return N;
else
return
Unchecked_Convert_To (Corresponding_Record_Type (Typ),
New_Copy_Tree (N));
Unchecked_Convert_To
(Corresponding_Record_Type (Typ), New_Copy_Tree (N));
end if;
end Convert_Concurrent;
......
gcc/ada/make.adb
......@@ -557,25 +557,6 @@ package body Make is
procedure List_Bad_Compilations;
-- Prints out the list of all files for which the compilation failed
procedure Verbose_Msg
(N1 : Name_Id;
S1 : String;
N2 : Name_Id := No_Name;
S2 : String := "";
Prefix : String := " -> ";
Minimum_Verbosity : 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 : 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.
Usage_Needed : Boolean := True;
-- Flag used to make sure Makeusg is call at most once
......@@ -1434,10 +1415,6 @@ package body Make is
O_File : out File_Name_Type;
O_Stamp : out Time_Stamp_Type)
is
function File_Not_A_Source_Of
(Uname : Name_Id;
Sfile : File_Name_Type) return Boolean;
function First_New_Spec (A : ALI_Id) return File_Name_Type;
-- Looks in the with table entries of A and returns the spec file name
-- of the first withed unit (subprogram) for which no spec existed when
......@@ -1452,34 +1429,6 @@ package body Make is
-- services, but this causes the whole compiler to be dragged along
-- for gnatbind and gnatmake.
--------------------------
-- File_Not_A_Source_Of --
--------------------------
function File_Not_A_Source_Of
(Uname : Name_Id;
Sfile : File_Name_Type) return Boolean
is
UID : Prj.Unit_Index;
begin
UID := Units_Htable.Get (Project_Tree.Units_HT, Uname);
if UID /= Prj.No_Unit_Index then
if (UID.File_Names (Impl) = null
or else UID.File_Names (Impl).File /= Sfile)
and then
(UID.File_Names (Spec) = null
or else UID.File_Names (Spec).File /= Sfile)
then
Verbose_Msg (Uname, "sources do not include ", Name_Id (Sfile));
return True;
end if;
end if;
return False;
end File_Not_A_Source_Of;
--------------------
-- First_New_Spec --
--------------------
......@@ -8240,52 +8189,6 @@ package body Make is
end if;
end Usage;
-----------------
-- Verbose_Msg --
-----------------
procedure Verbose_Msg
(N1 : Name_Id;
S1 : String;
N2 : Name_Id := No_Name;
S2 : String := "";
Prefix : String := " -> ";
Minimum_Verbosity : Verbosity_Level_Type := Opt.Low)
is
begin
if (not Verbose_Mode) or else (Minimum_Verbosity > Verbosity_Level) then
return;
end if;
Write_Str (Prefix);
Write_Str ("""");
Write_Name (N1);
Write_Str (""" ");
Write_Str (S1);
if N2 /= No_Name then
Write_Str (" """);
Write_Name (N2);
Write_Str (""" ");
end if;
Write_Str (S2);
Write_Eol;
end Verbose_Msg;
procedure Verbose_Msg
(N1 : File_Name_Type;
S1 : String;
N2 : File_Name_Type := No_File;
S2 : String := "";
Prefix : String := " -> ";
Minimum_Verbosity : Verbosity_Level_Type := Opt.Low)
is
begin
Verbose_Msg
(Name_Id (N1), S1, Name_Id (N2), S2, Prefix, Minimum_Verbosity);
end Verbose_Msg;
begin
-- Make sure that in case of failure, the temp files will be deleted
......
gcc/ada/makeutl.adb
......@@ -26,6 +26,7 @@
with Debug;
with Osint; use Osint;
with Output; use Output;
with Opt; use Opt;
with Prj.Ext;
with Prj.Util;
with Snames; use Snames;
......@@ -264,6 +265,47 @@ package body Makeutl is
end;
end Executable_Prefix_Path;
--------------------------
-- File_Not_A_Source_Of --
--------------------------
function File_Not_A_Source_Of
(Uname : Name_Id;
Sfile : File_Name_Type) return Boolean
is
Unit : constant Unit_Index :=
Units_Htable.Get (Project_Tree.Units_HT, Uname);
At_Least_One_File : Boolean := False;
begin
if Unit /= No_Unit_Index then
for F in Unit.File_Names'Range loop
if Unit.File_Names (F) /= null then
At_Least_One_File := True;
if Unit.File_Names (F).File = Sfile then
return False;
end if;
end if;
end loop;
if not At_Least_One_File then
-- The unit was probably created initially for a separate unit
-- (which are initially created as IMPL when both suffixes are the
-- same). Later on, Override_Kind changed the type of the file,
-- and the unit is no longer valid in fact.
return False;
end if;
Verbose_Msg (Uname, "sources do not include ", Name_Id (Sfile));
return True;
end if;
return False;
end File_Not_A_Source_Of;
----------
-- Hash --
----------
......@@ -749,4 +791,52 @@ package body Makeutl is
return Result;
end Unit_Index_Of;
-----------------
-- Verbose_Msg --
-----------------
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)
is
begin
if not Opt.Verbose_Mode
or else Minimum_Verbosity > Opt.Verbosity_Level
then
return;
end if;
Write_Str (Prefix);
Write_Str ("""");
Write_Name (N1);
Write_Str (""" ");
Write_Str (S1);
if N2 /= No_Name then
Write_Str (" """);
Write_Name (N2);
Write_Str (""" ");
end if;
Write_Str (S2);
Write_Eol;
end Verbose_Msg;
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)
is
begin
Verbose_Msg
(Name_Id (N1), S1, Name_Id (N2), S2, Prefix, Minimum_Verbosity);
end Verbose_Msg;
end Makeutl;
gcc/ada/makeutl.ads
......@@ -24,6 +24,7 @@
------------------------------------------------------------------------------
with Namet; use Namet;
with Opt;
with Osint;
with Prj; use Prj;
with Types; use Types;
......@@ -69,6 +70,13 @@ package Makeutl is
procedure Inform (N : File_Name_Type; Msg : String);
-- Prints out the program name followed by a colon, N and S
function File_Not_A_Source_Of
(Uname : Name_Id;
Sfile : File_Name_Type) return Boolean;
-- Check that file name Sfile is one of the source of unit Uname.
-- Returns True if the unit is in one of the project file, but the file
-- name is not one of its source. Returns False otherwise.
function Is_External_Assignment (Argv : String) return Boolean;
-- Verify that an external assignment switch is syntactically correct
--
......@@ -82,6 +90,25 @@ package Makeutl is
-- been entered by a call to Prj.Ext.Add, so that in a project
-- file, External ("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.
function Linker_Options_Switches
(Project : Project_Id;
In_Tree : Project_Tree_Ref) return String_List;
......
gcc/ada/prj.adb
......@@ -1069,8 +1069,8 @@ package body Prj is
begin
-- A project is not importing itself
if Project /= Prj then
Prj2 := Ultimate_Extending_Project_Of (Prj);
Prj2 := Ultimate_Extending_Project_Of (Prj);
if Project /= Prj2 then
-- Check that the project is not already in the list. We know the
-- one passed to Recursive_Add have never been visited before, but
......
gcc/ada/prj.ads
......@@ -1061,7 +1061,8 @@ package Prj is
-- The list of all directly imported projects, if any
All_Imported_Projects : Project_List;
-- The list of all projects imported directly or indirectly, if any
-- The list of all projects imported directly or indirectly, if any.
-- This does not include the project itself.
-----------------
-- Directories --
......
gcc/ada/sinfo.ads
......@@ -6850,15 +6850,16 @@ package Sinfo is
-- SCIL Nodes --
-----------------
-- SCIL nodes are special nodes added to the tree when the CodePeer mode
-- is active. They help CodePeer backend to locate nodes that require
-- special processing.
-- Where is the detailed description of what these nodes are for??? The
-- above is not sufficient. The description should be here, or perhaps
-- it could be in a new Sem_SCIL unit, with a pointer from here. But
-- right now I am afraid this documentation is missing and the purpose
-- of these nodes remains secret???
-- SCIL nodes are special nodes added to the tree when the CodePeer
-- mode is active. They help the CodePeer backend to locate nodes that
-- require special processing.
-- Major documentation on the general design of the SCIL interface, and
-- in particular detailed description of these nodes is missing and is
-- to be supplied in the future, when the design has finalized ???
-- Meanwhile these nodes should be considered in experimental form, and
-- should be ignored by all code generating back ends. ???
-- N_SCIL_Dispatch_Table_Object_Init
-- Sloc references a declaration node containing a dispatch table
......
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