Skip to content

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

2017-04-25 Arnaud Charlet <charlet@adacore.com trojanek> 

	* gnat1drv.adb (Gnat1Drv): Disable Generate_Processed_File in
	codepeer mode.

2017-04-25  Javier Miranda  <miranda@adacore.com>

	* urealp.adb (UR_Write): Fix output of constants with a base other
	that 10.

2017-04-25  Justin Squirek  <squirek@adacore.com>

	* sem_ch13.adb (Get_Interfacing_Aspects): Moved to sem_util.adb.
	* sem_prag.adb (Analyze_Pragma, Process_Import_Or_Interface):
	Add extra parameter for Process_Interface_Name.
	(Process_Interface_Name): Add parameter for pragma to analyze
	corresponding aspect.
	* sem_util.ads, sem_util.adb (Get_Interfacing_Aspects): Added
	from sem_ch13.adb

From-SVN: r247160
parent 2700fbd6
Showing with 198 additions and 137 deletions
gcc/ada/ChangeLog
2017-04-25 Arnaud Charlet <charlet@adacore.com trojanek>
* gnat1drv.adb (Gnat1Drv): Disable Generate_Processed_File in
codepeer mode.
2017-04-25 Javier Miranda <miranda@adacore.com>
* urealp.adb (UR_Write): Fix output of constants with a base other
that 10.
2017-04-25 Justin Squirek <squirek@adacore.com>
* sem_ch13.adb (Get_Interfacing_Aspects): Moved to sem_util.adb.
* sem_prag.adb (Analyze_Pragma, Process_Import_Or_Interface):
Add extra parameter for Process_Interface_Name.
(Process_Interface_Name): Add parameter for pragma to analyze
corresponding aspect.
* sem_util.ads, sem_util.adb (Get_Interfacing_Aspects): Added
from sem_ch13.adb
2017-04-25 Gary Dismukes <dismukes@adacore.com>
* exp_ch7.adb, einfo.ads, sem_prag.adb: Minor reformatting and typo
......
gcc/ada/gnat1drv.adb
......@@ -286,6 +286,11 @@ procedure Gnat1drv is
Debug_Generated_Code := False;
-- Ditto for -gnateG which interacts badly with handling of pragma
-- Annotate in gnat2scil.
Generate_Processed_File := False;
-- Disable Exception_Extra_Info (-gnateE) which generates more
-- complex trees with no added value, and may confuse CodePeer.
......
gcc/ada/sem_ch13.adb
......@@ -147,27 +147,6 @@ package body Sem_Ch13 is
-- Uint value. If the value is inappropriate, then error messages are
-- posted as required, and a value of No_Uint is returned.
procedure Get_Interfacing_Aspects
(Iface_Asp : Node_Id;
Conv_Asp : out Node_Id;
EN_Asp : out Node_Id;
Expo_Asp : out Node_Id;
Imp_Asp : out Node_Id;
LN_Asp : out Node_Id;
Do_Checks : Boolean := False);
-- Given a single interfacing aspect Iface_Asp, retrieve other interfacing
-- aspects that apply to the same related entity. The aspects considered by
-- this routine are as follows:
--
-- Conv_Asp - aspect Convention
-- EN_Asp - aspect External_Name
-- Expo_Asp - aspect Export
-- Imp_Asp - aspect Import
-- LN_Asp - aspect Link_Name
--
-- When flag Do_Checks is set, this routine will flag duplicate uses of
-- aspects.
function Is_Operational_Item (N : Node_Id) return Boolean;
-- A specification for a stream attribute is allowed before the full type
-- is declared, as explained in AI-00137 and the corrigendum. Attributes
......@@ -11214,106 +11193,6 @@ package body Sem_Ch13 is
end if;
end Get_Alignment_Value;
-----------------------------
-- Get_Interfacing_Aspects --
-----------------------------
procedure Get_Interfacing_Aspects
(Iface_Asp : Node_Id;
Conv_Asp : out Node_Id;
EN_Asp : out Node_Id;
Expo_Asp : out Node_Id;
Imp_Asp : out Node_Id;
LN_Asp : out Node_Id;
Do_Checks : Boolean := False)
is
procedure Save_Or_Duplication_Error
(Asp : Node_Id;
To : in out Node_Id);
-- Save the value of aspect Asp in node To. If To already has a value,
-- then this is considered a duplicate use of aspect. Emit an error if
-- flag Do_Checks is set.
-------------------------------
-- Save_Or_Duplication_Error --
-------------------------------
procedure Save_Or_Duplication_Error
(Asp : Node_Id;
To : in out Node_Id)
is
begin
-- Detect an extra aspect and issue an error
if Present (To) then
if Do_Checks then
Error_Msg_Name_1 := Chars (Identifier (Asp));
Error_Msg_Sloc := Sloc (To);
Error_Msg_N ("aspect % previously given #", Asp);
end if;
-- Otherwise capture the aspect
else
To := Asp;
end if;
end Save_Or_Duplication_Error;
-- Local variables
Asp : Node_Id;
Asp_Id : Aspect_Id;
-- The following variables capture each individual aspect
Conv : Node_Id := Empty;
EN : Node_Id := Empty;
Expo : Node_Id := Empty;
Imp : Node_Id := Empty;
LN : Node_Id := Empty;
-- Start of processing for Get_Interfacing_Aspects
begin
-- The input interfacing aspect should reside in an aspect specification
-- list.
pragma Assert (Is_List_Member (Iface_Asp));
-- Examine the aspect specifications of the related entity. Find and
-- capture all interfacing aspects. Detect duplicates and emit errors
-- if applicable.
Asp := First (List_Containing (Iface_Asp));
while Present (Asp) loop
Asp_Id := Get_Aspect_Id (Asp);
if Asp_Id = Aspect_Convention then
Save_Or_Duplication_Error (Asp, Conv);
elsif Asp_Id = Aspect_External_Name then
Save_Or_Duplication_Error (Asp, EN);
elsif Asp_Id = Aspect_Export then
Save_Or_Duplication_Error (Asp, Expo);
elsif Asp_Id = Aspect_Import then
Save_Or_Duplication_Error (Asp, Imp);
elsif Asp_Id = Aspect_Link_Name then
Save_Or_Duplication_Error (Asp, LN);
end if;
Next (Asp);
end loop;
Conv_Asp := Conv;
EN_Asp := EN;
Expo_Asp := Expo;
Imp_Asp := Imp;
LN_Asp := LN;
end Get_Interfacing_Aspects;
-------------------------------------
-- Inherit_Aspects_At_Freeze_Point --
-------------------------------------
......
gcc/ada/sem_prag.adb
......@@ -3927,7 +3927,8 @@ package body Sem_Prag is
procedure Process_Interface_Name
(Subprogram_Def : Entity_Id;
Ext_Arg : Node_Id;
Link_Arg : Node_Id);
Link_Arg : Node_Id;
Prag : Node_Id);
-- Given the last two arguments of pragma Import, pragma Export, or
-- pragma Interface_Name, performs validity checks and sets the
-- Interface_Name field of the given subprogram entity to the
......@@ -3936,7 +3937,9 @@ package body Sem_Prag is
-- Ext_Arg may represent the Link_Name if Link_Arg is missing, and
-- appropriate named notation is used for Ext_Arg. If neither Ext_Arg
-- nor Link_Arg is present, the interface name is set to the default
-- from the subprogram name.
-- from the subprogram name. In addition, the pragma itself is passed
-- to analyze any expressions in the case the pragma came from an aspect
-- specification.
procedure Process_Interrupt_Or_Attach_Handler;
-- Common processing for Interrupt and Attach_Handler pragmas
......@@ -8421,7 +8424,7 @@ package body Sem_Prag is
Set_Imported (Def_Id);
end if;
Process_Interface_Name (Def_Id, Arg3, Arg4);
Process_Interface_Name (Def_Id, Arg3, Arg4, N);
-- Note that we do not set Is_Public here. That's because we
-- only want to set it if there is no address clause, and we
......@@ -8583,7 +8586,7 @@ package body Sem_Prag is
end if;
end;
Process_Interface_Name (Def_Id, Arg3, Arg4);
Process_Interface_Name (Def_Id, Arg3, Arg4, N);
end if;
if Is_Compilation_Unit (Hom_Id) then
......@@ -9128,7 +9131,8 @@ package body Sem_Prag is
procedure Process_Interface_Name
(Subprogram_Def : Entity_Id;
Ext_Arg : Node_Id;
Link_Arg : Node_Id)
Link_Arg : Node_Id;
Prag : Node_Id)
is
Ext_Nam : Node_Id;
Link_Nam : Node_Id;
......@@ -9179,6 +9183,40 @@ package body Sem_Prag is
-- Start of processing for Process_Interface_Name
begin
-- If we are looking at a pragma that comes from an aspect then it
-- needs to have its corresponding aspect argument expressions
-- analyzed in addition to the generated pragma so that aspects
-- within generic units get properly resolved.
if Present (Prag) and then From_Aspect_Specification (Prag) then
declare
Asp : constant Node_Id := Corresponding_Aspect (Prag);
Dummy_1 : Node_Id;
Dummy_2 : Node_Id;
Dummy_3 : Node_Id;
EN : Node_Id;
LN : Node_Id;
begin
-- Obtain all interfacing aspects used to construct the pragma
Get_Interfacing_Aspects
(Asp, Dummy_1, EN, Dummy_2, Dummy_3, LN);
-- Analyze the expression of aspect External_Name
if Present (EN) then
Analyze (Expression (EN));
end if;
-- Analyze the expressio of aspect Link_Name
if Present (LN) then
Analyze (Expression (LN));
end if;
end;
end if;
if No (Link_Arg) then
if No (Ext_Arg) then
return;
......@@ -13497,7 +13535,7 @@ package body Sem_Prag is
if Arg_Count >= 2 then
Set_Imported (Def_Id);
Set_Is_Public (Def_Id);
Process_Interface_Name (Def_Id, Arg2, Arg3);
Process_Interface_Name (Def_Id, Arg2, Arg3, N);
end if;
Set_Has_Completion (Def_Id);
......@@ -14648,7 +14686,7 @@ package body Sem_Prag is
(Get_Pragma_Arg (Arg2), Sure => False);
end if;
Process_Interface_Name (Def_Id, Arg3, Arg4);
Process_Interface_Name (Def_Id, Arg3, Arg4, N);
Set_Exported (Def_Id, Arg2);
end if;
......@@ -15154,7 +15192,7 @@ package body Sem_Prag is
Note_Possible_Modification
(Get_Pragma_Arg (Arg2), Sure => False);
Process_Interface_Name (E, Arg3, Arg4);
Process_Interface_Name (E, Arg3, Arg4, N);
Set_Exported (E, Arg2);
end External;
......@@ -16607,7 +16645,7 @@ package body Sem_Prag is
end if;
Set_Is_Public (Def_Id);
Process_Interface_Name (Def_Id, Arg2, Arg3);
Process_Interface_Name (Def_Id, Arg2, Arg3, N);
end if;
-- Otherwise must be subprogram
......@@ -16627,7 +16665,7 @@ package body Sem_Prag is
Def_Id := Get_Base_Subprogram (Hom_Id);
if Is_Imported (Def_Id) then
Process_Interface_Name (Def_Id, Arg2, Arg3);
Process_Interface_Name (Def_Id, Arg2, Arg3, N);
Found := True;
end if;
gcc/ada/sem_util.adb
......@@ -8181,6 +8181,106 @@ package body Sem_Util is
end if;
end Get_Index_Bounds;
-----------------------------
-- Get_Interfacing_Aspects --
-----------------------------
procedure Get_Interfacing_Aspects
(Iface_Asp : Node_Id;
Conv_Asp : out Node_Id;
EN_Asp : out Node_Id;
Expo_Asp : out Node_Id;
Imp_Asp : out Node_Id;
LN_Asp : out Node_Id;
Do_Checks : Boolean := False)
is
procedure Save_Or_Duplication_Error
(Asp : Node_Id;
To : in out Node_Id);
-- Save the value of aspect Asp in node To. If To already has a value,
-- then this is considered a duplicate use of aspect. Emit an error if
-- flag Do_Checks is set.
-------------------------------
-- Save_Or_Duplication_Error --
-------------------------------
procedure Save_Or_Duplication_Error
(Asp : Node_Id;
To : in out Node_Id)
is
begin
-- Detect an extra aspect and issue an error
if Present (To) then
if Do_Checks then
Error_Msg_Name_1 := Chars (Identifier (Asp));
Error_Msg_Sloc := Sloc (To);
Error_Msg_N ("aspect % previously given #", Asp);
end if;
-- Otherwise capture the aspect
else
To := Asp;
end if;
end Save_Or_Duplication_Error;
-- Local variables
Asp : Node_Id;
Asp_Id : Aspect_Id;
-- The following variables capture each individual aspect
Conv : Node_Id := Empty;
EN : Node_Id := Empty;
Expo : Node_Id := Empty;
Imp : Node_Id := Empty;
LN : Node_Id := Empty;
-- Start of processing for Get_Interfacing_Aspects
begin
-- The input interfacing aspect should reside in an aspect specification
-- list.
pragma Assert (Is_List_Member (Iface_Asp));
-- Examine the aspect specifications of the related entity. Find and
-- capture all interfacing aspects. Detect duplicates and emit errors
-- if applicable.
Asp := First (List_Containing (Iface_Asp));
while Present (Asp) loop
Asp_Id := Get_Aspect_Id (Asp);
if Asp_Id = Aspect_Convention then
Save_Or_Duplication_Error (Asp, Conv);
elsif Asp_Id = Aspect_External_Name then
Save_Or_Duplication_Error (Asp, EN);
elsif Asp_Id = Aspect_Export then
Save_Or_Duplication_Error (Asp, Expo);
elsif Asp_Id = Aspect_Import then
Save_Or_Duplication_Error (Asp, Imp);
elsif Asp_Id = Aspect_Link_Name then
Save_Or_Duplication_Error (Asp, LN);
end if;
Next (Asp);
end loop;
Conv_Asp := Conv;
EN_Asp := EN;
Expo_Asp := Expo;
Imp_Asp := Imp;
LN_Asp := LN;
end Get_Interfacing_Aspects;
---------------------------------
-- Get_Iterable_Type_Primitive --
---------------------------------
......
gcc/ada/sem_util.ads
......@@ -923,6 +923,27 @@ package Sem_Util is
-- the index type turns out to be a partial view; this case should not
-- arise during normal compilation of semantically correct programs.
procedure Get_Interfacing_Aspects
(Iface_Asp : Node_Id;
Conv_Asp : out Node_Id;
EN_Asp : out Node_Id;
Expo_Asp : out Node_Id;
Imp_Asp : out Node_Id;
LN_Asp : out Node_Id;
Do_Checks : Boolean := False);
-- Given a single interfacing aspect Iface_Asp, retrieve other interfacing
-- aspects that apply to the same related entity. The aspects considered by
-- this routine are as follows:
--
-- Conv_Asp - aspect Convention
-- EN_Asp - aspect External_Name
-- Expo_Asp - aspect Export
-- Imp_Asp - aspect Import
-- LN_Asp - aspect Link_Name
--
-- When flag Do_Checks is set, this routine will flag duplicate uses of
-- aspects.
function Get_Enum_Lit_From_Pos
(T : Entity_Id;
Pos : Uint;
......
gcc/ada/urealp.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2016, 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- --
......@@ -1472,8 +1472,8 @@ package body Urealp is
-- of the following forms, depending on the sign of the number
-- and the sign of the exponent (= minus denominator value)
-- numerator.0*base**exponent
-- numerator.0*base**-exponent
-- numerator.0/base**exponent
-- numerator.0/base**-exponent
-- And of course an exponent of 0 can be omitted
......@@ -1486,16 +1486,14 @@ package body Urealp is
Write_Str (".0");
if Val.Den /= 0 then
Write_Char ('*');
Write_Char ('/');
Write_Int (Val.Rbase);
Write_Str ("**");
if Val.Den <= 0 then
UI_Write (-Val.Den, Decimal);
else
Write_Str ("(-");
UI_Write (Val.Den, Decimal);
Write_Char (')');
end if;
end if;
......
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