+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
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.
-- 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
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 --
-------------------------------------
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
-- 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
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
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
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;
-- 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;
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);
(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;
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;
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
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;
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 --
---------------------------------
-- 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;
-- --
-- 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- --
-- 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
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;
projects / gcc.git / commitdiff