Skip to content

R
riscv-gcc-1
Commit 7b00e31d by Arnaud Charlet
Options

[multiple changes] 

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

	* prj.ads, prj-dect.adb, prj-err.ads, prj-err.adb, prj-nmsc.adb,
	prj-strt.ads: Minor reformatting

2009-07-13  Thomas Quinot  <quinot@adacore.com>

	* exp_dist.adb (Build_From_Any_Call): For the case of a generic type,
	set the type of the From_Any call to the base type.

2009-07-13  Doug Rupp  <rupp@adacore.com>

	* symbols-processing-vms-ia64.adb (Process): Add variables and
	constants to retrieve and check for symbol visibility.

2009-07-13  Javier Miranda  <miranda@adacore.com>

	* exp_ch4.adb (Expand_N_Unchecked_Type_Conversion): If conversion is to
	the identical type we remove the conversion completely because
	it is useless.

From-SVN: r149575
parent 0e41a941
Showing with 106 additions and 56 deletions
gcc/ada/ChangeLog
2009-07-13 Robert Dewar <dewar@adacore.com>
* prj.ads, prj-dect.adb, prj-err.ads, prj-err.adb, prj-nmsc.adb,
prj-strt.ads: Minor reformatting
2009-07-13 Thomas Quinot <quinot@adacore.com>
* exp_dist.adb (Build_From_Any_Call): For the case of a generic type,
set the type of the From_Any call to the base type.
2009-07-13 Doug Rupp <rupp@adacore.com>
* symbols-processing-vms-ia64.adb (Process): Add variables and
constants to retrieve and check for symbol visibility.
2009-07-13 Javier Miranda <miranda@adacore.com>
* exp_ch4.adb (Expand_N_Unchecked_Type_Conversion): If conversion is to
the identical type we remove the conversion completely because
it is useless.
2009-07-13 Emmanuel Briot <briot@adacore.com>
* prj-err.adb (Error_Msg): One more case where a message should be
......
gcc/ada/exp_ch4.adb
......@@ -7919,6 +7919,13 @@ package body Exp_Ch4 is
-- the conversion completely, it is useless.
if Operand_Type = Target_Type then
-- Propagate Assignment_OK attribute to the operand
if Assignment_OK (N) then
Set_Assignment_OK (Operand);
end if;
Rewrite (N, Relocate_Node (Operand));
return;
end if;
......@@ -8506,6 +8513,21 @@ package body Exp_Ch4 is
Operand_Type : constant Entity_Id := Etype (Operand);
begin
-- Nothing at all to do if conversion is to the identical type so remove
-- the conversion completely, it is useless.
if Operand_Type = Target_Type then
-- Propagate Assignment_OK attribute to the operand
if Assignment_OK (N) then
Set_Assignment_OK (Operand);
end if;
Rewrite (N, Relocate_Node (Operand));
return;
end if;
-- If we have a conversion of a compile time known value to a target
-- type and the value is in range of the target type, then we can simply
-- replace the construct by an integer literal of the correct type. We
......
gcc/ada/exp_dist.adb
......@@ -8617,17 +8617,16 @@ package body Exp_Dist is
else
declare
Decl : Entity_Id;
Typ : Entity_Id := U_Type;
begin
-- For the subtype representing a generic actual type, go
-- to the base type.
if Is_Generic_Actual_Type (Typ) then
Typ := Base_Type (Typ);
if Is_Generic_Actual_Type (U_Type) then
U_Type := Base_Type (U_Type);
end if;
Build_From_Any_Function (Loc, Typ, Decl, Fnam);
Build_From_Any_Function (Loc, U_Type, Decl, Fnam);
Append_To (Decls, Decl);
end;
end if;
......
gcc/ada/prj-dect.adb
......@@ -79,10 +79,9 @@ package body Prj.Dect is
Packages_To_Check : String_List_Access;
Is_Config_File : Boolean;
Flags : Processing_Flags);
-- Parse declarative items. Depending on In_Zone, some declarative
-- items may be forbidden.
-- Is_Config_File should be set to True if the project represents a config
-- file (.cgpr) since some specific checks apply.
-- Parse declarative items. Depending on In_Zone, some declarative items
-- may be forbidden. Is_Config_File should be set to True if the project
-- represents a config file (.cgpr) since some specific checks apply.
procedure Parse_Package_Declaration
(In_Tree : Project_Node_Tree_Ref;
......
gcc/ada/prj-err.adb
......@@ -99,9 +99,11 @@ package body Prj.Err is
end if;
if Real_Location = No_Location then
-- If still null, we are parsing a project that was created in-memory
-- so we shouldn't report errors for projects that the user has no
-- access to in any case.
return;
end if;
......@@ -115,7 +117,7 @@ package body Prj.Err is
if Flags.Report_Error /= null then
Flags.Report_Error
(Project,
Is_Warning => Msg (Msg'First) = '?' or Msg (Msg'First) = '<');
Is_Warning => Msg (Msg'First) = '?' or else Msg (Msg'First) = '<');
end if;
end Error_Msg;
......
gcc/ada/prj-err.ads
......@@ -73,11 +73,10 @@ package Prj.Err is
Location : Source_Ptr := No_Location;
Project : Project_Id := null);
-- Output an error message, either through Flags.Error_Report or through
-- Errutil. The location defaults to the project's location ("project" in
-- the source code).
-- If Msg starts with "?", this is a warning, and Warning: is added at the
-- beginning. If Msg starts with "<", see comment for
-- Err_Vars.Error_Msg_Warn
-- Errutil. The location defaults to the project's location ("project"
-- in the source code). If Msg starts with "?", this is a warning, and
-- Warning: is added at the beginning. If Msg starts with "<", see comment
-- for Err_Vars.Error_Msg_Warn.
-------------
-- Scanner --
......
gcc/ada/prj-nmsc.adb
......@@ -552,6 +552,7 @@ package body Prj.Nmsc is
Add_Src : Boolean;
Source : Source_Id;
Prev_Unit : Unit_Index := No_Unit_Index;
Source_To_Replace : Source_Id := No_Source;
begin
......@@ -619,12 +620,12 @@ package body Prj.Nmsc is
end if;
end if;
-- Do not allow the same unit name in different projects,
-- except if one is extending the other.
-- Do not allow the same unit name in different projects, except
-- if one is extending the other.
-- For a file based language, the same file name replaces
-- a file in a project being extended, but it is allowed
-- to have the same file name in unrelated projects.
-- For a file based language, the same file name replaces a file
-- in a project being extended, but it is allowed to have the same
-- file name in unrelated projects.
elsif Is_Extending (Project, Source.Project) then
if not Locally_Removed then
......
gcc/ada/prj-strt.ads
......@@ -37,10 +37,10 @@ private package Prj.Strt is
-- On entry, the current token is the first literal string following
-- a left parenthesis in a string type declaration such as:
-- type Toto is ("string_1", "string_2", "string_3");
-- On exit, the current token is the right parenthesis.
-- The parameter First_String is a node that contained the first
-- literal string of the string type, linked with the following
-- literal strings.
--
-- On exit, the current token is the right parenthesis. The parameter
-- First_String is a node that contained the first literal string of the
-- string type, linked with the following literal strings.
--
-- Report an error if
-- - a literal string is not found at the beginning of the list
......@@ -50,24 +50,22 @@ private package Prj.Strt is
procedure Start_New_Case_Construction
(In_Tree : Project_Node_Tree_Ref;
String_Type : Project_Node_Id);
-- This procedure is called at the beginning of a case construction
-- The parameter String_Type is the node for the string type
-- of the case label variable.
-- The different literal strings of the string type are stored
-- into a table to be checked against the case labels of the
-- case construction.
-- This procedure is called at the beginning of a case construction The
-- parameter String_Type is the node for the string type of the case label
-- variable. The different literal strings of the string type are stored
-- into a table to be checked against the case labels of the case
-- construction.
procedure End_Case_Construction
(Check_All_Labels : Boolean;
Case_Location : Source_Ptr;
Flags : Processing_Flags);
-- This procedure is called at the end of a case construction
-- to remove the case labels and to restore the previous state.
-- In particular, in the case of nested case constructions,
-- the case labels of the enclosing case construction are restored.
-- When When_Others is False and we are not in quiet output, a warning
-- is emitted for each value of the case variable string type that has
-- not been specified.
-- This procedure is called at the end of a case construction to remove the
-- case labels and to restore the previous state. In particular, in the
-- case of nested case constructions, the case labels of the enclosing case
-- construction are restored. When When_Others is False and we are not in
-- quiet output, a warning is emitted for each value of the case variable
-- string type that has not been specified.
procedure Parse_Choice_List
(In_Tree : Project_Node_Tree_Ref;
......@@ -86,12 +84,13 @@ private package Prj.Strt is
Current_Package : Project_Node_Id;
Optional_Index : Boolean;
Flags : Processing_Flags);
-- Parse a simple string expression or a string list expression.
-- Current_Project is the node of the project file being parsed.
-- Current_Package is the node of the package being parsed,
-- or Empty_Node when we are at the project level (not in a package).
-- On exit, Expression is the node of the expression that has
-- been parsed.
-- Parse a simple string expression or a string list expression
--
-- Current_Project is the node of the project file being parsed
--
-- Current_Package is the node of the package being parsed, or Empty_Node
-- when we are at the project level (not in a package). On exit, Expression
-- is the node of the expression that has been parsed.
procedure Parse_Variable_Reference
(In_Tree : Project_Node_Tree_Ref;
......@@ -99,13 +98,12 @@ private package Prj.Strt is
Current_Project : Project_Node_Id;
Current_Package : Project_Node_Id;
Flags : Processing_Flags);
-- Parse a variable or attribute reference.
-- Used internally (in expressions) and for case variables (in Prj.Dect).
-- Current_Package is the node of the package being parsed,
-- or Empty_Node when we are at the project level (not in a package).
-- On exit, Variable is the node of the variable or attribute reference.
-- A variable reference is made of one to three simple names.
-- An attribute reference is made of one or two simple names,
-- Parse variable or attribute reference. Used internally (in expressions)
-- and for case variables (in Prj.Dect). Current_Package is the node of the
-- package being parsed, or Empty_Node when we are at the project level
-- (not in a package). On exit, Variable is the node of the variable or
-- attribute reference. A variable reference is made of one to three simple
-- names. An attribute reference is made of one or two simple names,
-- followed by an apostrophe, followed by the attribute simple name.
end Prj.Strt;
gcc/ada/prj.ads
......@@ -1362,12 +1362,13 @@ package Prj is
-- - Error: issue an error, causes the tool to fail
type Error_Handler is access procedure
(Project : Project_Id; Is_Warning : Boolean);
(Project : Project_Id;
Is_Warning : Boolean);
-- This warngs when an error was found when parsing a project. The error
-- itself is handled through Prj.Err (and you should call
-- Prj.Err.Finalize to actually print the error). This ensures that
-- duplicate error messages are always correctly removed, that errors msgs
-- are sorted, and that all tools will report the same error to the user.
-- itself is handled through Prj.Err (and Prj.Err.Finalize should be called
-- to actually print the error). This ensures that duplicate error messages
-- are always correctly removed, that errors msgs are sorted, and that all
-- tools will report the same error to the user.
function Create_Flags
(Report_Error : Error_Handler;
......
gcc/ada/symbols-processing-vms-ia64.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2004-2007, Free Software Foundation, Inc. --
-- Copyright (C) 2004-2009, 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- --
......@@ -85,9 +85,14 @@ package body Processing is
Stname : Integer;
Stinfo : Character;
Stother : Character;
Sttype : Integer;
Stbind : Integer;
Stshndx : Integer;
Stvis : Integer;
STV_Internal : constant := 1;
STV_Hidden : constant := 2;
Section_Headers : Section_Header_Ptr;
......@@ -340,7 +345,7 @@ package body Processing is
while Offset < End_Symtab loop
Get_Word (Stname);
Get_Byte (Stinfo);
Get_Byte (B);
Get_Byte (Stother);
Get_Half (Stshndx);
for J in 1 .. 4 loop
Get_Word (W);
......@@ -348,10 +353,13 @@ package body Processing is
Sttype := Integer'(Character'Pos (Stinfo)) mod 16;
Stbind := Integer'(Character'Pos (Stinfo)) / 16;
Stvis := Integer'(Character'Pos (Stother)) mod 4;
if (Sttype = 1 or else Sttype = 2)
and then Stbind /= 0
and then Stshndx /= 0
and then Stvis /= STV_Internal
and then Stvis /= STV_Hidden
then
-- Check if this is a symbol from a generic body
......
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