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

[multiple changes] 

2013-10-14  Robert Dewar  <dewar@adacore.com>

	* s-valuti.adb, prep.adb, scng.adb, errout.adb: Minor reformatting.

2013-10-14  Eric Botcazou  <ebotcazou@adacore.com>

	* adaint.c: Further disable __gnat_get_executable_load_address
	for Linux.

2013-10-14  Vincent Celier  <celier@adacore.com>

	* gnat_ugn.texi: Add documentation for comparing symbols to
	integers in preprocessing expressions.

2013-10-14  Jose Ruiz  <ruiz@adacore.com>

	* sem_prag.adb (Analyze_Aspect_Specification): For
	Priority and CPU aspects in subprograms, the expression in the
	aspect is analyzed and exported.
	(Analyze_Pragma): When having a Priority pragma in the
	main subprogram, load a unit that will force the initialization
	of the tasking run time, which is needed for setting the required
	priority.

2013-10-14  Vincent Celier  <celier@adacore.com>

	* prj-nmsc.adb (Check_Interfaces): Put in Other_Interfaces all
	non Ada interface files.
	* prj.ads (Project_Data): New component Other_Interfaces.

From-SVN: r203542
This commit is contained in:
Arnaud Charlet 2013-10-14 15:16:59 +02:00
parent ffd7623692
commit 5c211bfd5a
10 changed files with 186 additions and 100 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
gcc/ada/ChangeLog
View File

@ -1,3 +1,33 @@
2013-10-14 Robert Dewar <dewar@adacore.com>
* s-valuti.adb, prep.adb, scng.adb, errout.adb: Minor reformatting.
2013-10-14 Eric Botcazou <ebotcazou@adacore.com>
* adaint.c: Further disable __gnat_get_executable_load_address
for Linux.
2013-10-14 Vincent Celier <celier@adacore.com>
* gnat_ugn.texi: Add documentation for comparing symbols to
integers in preprocessing expressions.
2013-10-14 Jose Ruiz <ruiz@adacore.com>
* sem_prag.adb (Analyze_Aspect_Specification): For
Priority and CPU aspects in subprograms, the expression in the
aspect is analyzed and exported.
(Analyze_Pragma): When having a Priority pragma in the
main subprogram, load a unit that will force the initialization
of the tasking run time, which is needed for setting the required
priority.
2013-10-14 Vincent Celier <celier@adacore.com>
* prj-nmsc.adb (Check_Interfaces): Put in Other_Interfaces all
non Ada interface files.
* prj.ads (Project_Data): New component Other_Interfaces.
2013-10-14 Arnaud Charlet <charlet@adacore.com>
* gcc-interface/Makefile.in: Target pairs clean ups.

2
gcc/ada/adaint.c
View File

@ -3929,7 +3929,7 @@ void __gnat_cpu_set (int cpu, size_t count ATTRIBUTE_UNUSED, cpu_set_t *set)
#if defined (__APPLE__)
#include <mach-o/dyld.h>
#elif defined (__linux__)
#elif 0 && defined (__linux__)
#include <link.h>
#elif defined (__AIX__)
#include <sys/ldr.h>

5
gcc/ada/errout.adb
View File

@ -1625,8 +1625,9 @@ package body Errout is
Set_Standard_Error;
end if;
-- Message giving total number of lines, only when Main_Source_Line
-- is known.
-- Message giving total number of lines. Don't give this message if
-- the Main_Source line is unknown (this happens in error situations,
-- e.g. when integrated preprocessing fails).
if Main_Source_File /= No_Source_File then
Write_Str (" ");

12
gcc/ada/gnat_ugn.texi
View File

@ -16682,6 +16682,11 @@ In this example, @i{expression} is defined by the following grammar:
@i{expression} ::= <symbol>
@i{expression} ::= <symbol> = "<value>"
@i{expression} ::= <symbol> = <symbol>
@i{expression} ::= <symbol> = <integer>
@i{expression} ::= <symbol> > <integer>
@i{expression} ::= <symbol> >= <integer>
@i{expression} ::= <symbol> < <integer>
@i{expression} ::= <symbol> <= <integer>
@i{expression} ::= <symbol> 'Defined
@i{expression} ::= not @i{expression}
@i{expression} ::= @i{expression} and @i{expression}
@ -16714,6 +16719,11 @@ symbol definition must be one of the (case-insensitive) literals
corresponding lines are included, and if the value is false, they are
excluded.
When comparing a symbol to an integer, the integer is any non negative
literal integer as defined in the Ada Reference Manual, such as 3, 16#FF# or
2#11#. The symbol value must also be a non negative integer. Integer values
in the range 0 .. 2**31-1 are supported.
The test (@i{expression} ::= <symbol> @code{'Defined}) is true only if
the symbol has been defined in the definition file or by a @option{-D}
switch on the command line. Otherwise, the test is false.
@ -27447,7 +27457,7 @@ The preprocessing language allows such constructs as
@smallexample
@group
#if DEBUG or PRIORITY > 4 then
#if DEBUG or else (PRIORITY > 4) then
bunch of declarations
#else
completely different bunch of declarations

121
gcc/ada/prep.adb
View File

@ -147,21 +147,19 @@ package body Prep is
type Pp_State is record
If_Ptr : Source_Ptr;
-- The location of the #if statement.
-- Used to flag #if with no corresponding #end if, at the end.
-- The location of the #if statement (used to flag #if with no
-- corresponding #end if, at the end).
Else_Ptr : Source_Ptr;
-- The location of the #else statement.
-- Used to detect multiple #else.
-- The location of the #else statement (used to detect multiple #else's)
Deleting : Boolean;
-- Set to True when the code should be deleted or commented out
Match_Seen : Boolean;
-- Set to True when a condition in an #if or an #elsif is True.
-- Also set to True if Deleting at the previous level is True.
-- Used to decide if Deleting should be set to True in a following
-- #elsif or #else.
-- Set to True when a condition in an #if or an #elsif is True. Also set
-- to True if Deleting at the previous level is True. Used to decide if
-- Deleting should be set to True in a following #elsif or #else.
end record;
@ -190,13 +188,13 @@ package body Prep is
function Expression
(Evaluate_It : Boolean;
Complemented : Boolean := False) return Boolean;
-- Evaluate a condition in an #if or an #elsif statement.
-- If Evaluate_It is False, the condition is effectively evaluated,
-- otherwise, only the syntax is checked.
-- Evaluate a condition in an #if or an #elsif statement. If Evaluate_It
-- is False, the condition is effectively evaluated, otherwise, only the
-- syntax is checked.
procedure Go_To_End_Of_Line;
-- Advance the scan pointer until we reach an end of line or the end
-- of the buffer.
-- Advance the scan pointer until we reach an end of line or the end of the
-- buffer.
function Matching_Strings (S1, S2 : String_Id) return Boolean;
-- Returns True if the two string parameters are equal (case insensitive)
@ -251,6 +249,7 @@ package body Prep is
-- If no character '=', then the value is True
if Index = 0 then
-- Put the symbol in the name buffer
Name_Len := Definition'Length;
@ -377,8 +376,8 @@ package body Prep is
Complemented : Boolean := False) return Boolean
is
Evaluation : Boolean := Evaluate_It;
-- Is set to False after an "or else" when left term is True and
-- after an "and then" when left term is False.
-- Is set to False after an "or else" when left term is True and after
-- an "and then" when left term is False.
Final_Result : Boolean := False;
@ -405,12 +404,13 @@ package body Prep is
Current_Result := False;
-- Scan current term, starting with Token
case Token is
-- Handle parenthesized expression
when Tok_Left_Paren =>
-- ( expression )
Scan.all;
Current_Result := Expression (Evaluation);
@ -422,14 +422,15 @@ package body Prep is
("`)` expected", Token_Ptr);
end if;
-- Handle not expression
when Tok_Not =>
-- not expression
Scan.all;
Current_Result :=
not Expression (Evaluation, Complemented => True);
-- Handle sequence starting with identifier
when Tok_Identifier =>
Symbol_Name1 := Token_Name;
Symbol_Pos1 := Token_Ptr;
@ -454,11 +455,13 @@ package body Prep is
Current_Result := Index_Of (Symbol_Name1) /= No_Symbol;
end if;
-- Handle relational operator
elsif
Token = Tok_Equal or else
Token = Tok_Less or else
Token = Tok_Equal or else
Token = Tok_Less or else
Token = Tok_Less_Equal or else
Token = Tok_Greater or else
Token = Tok_Greater or else
Token = Tok_Greater_Equal
then
Relop := Token;
@ -476,7 +479,10 @@ package body Prep is
declare
Value : constant Int := UI_To_Int (Int_Literal_Value);
Data : Symbol_Data;
Symbol_Value : Int;
-- Value of symbol as Int
begin
if Evaluation then
Symbol1 := Index_Of (Symbol_Name1);
@ -530,7 +536,7 @@ package body Prep is
when Constraint_Error =>
Error_Msg_Name_1 := Symbol_Name1;
Error_Msg
("symbol % value is not integer",
("symbol % value is not an integer",
Symbol_Pos1);
end;
end if;
@ -540,9 +546,13 @@ package body Prep is
Scan.all;
end;
-- Error if relational operator other than = if not numbers
elsif Relop /= Tok_Equal then
Error_Msg ("number expected", Token_Ptr);
-- Equality comparison of two strings
elsif Token = Tok_Identifier then
-- symbol = symbol
@ -586,10 +596,11 @@ package body Prep is
end if;
if Symbol_Value1 /= No_String
and then Symbol_Value2 /= No_String
and then
Symbol_Value2 /= No_String
then
Current_Result := Matching_Strings
(Symbol_Value1, Symbol_Value2);
Current_Result :=
Matching_Strings (Symbol_Value1, Symbol_Value2);
end if;
end if;
@ -630,9 +641,9 @@ package body Prep is
Token_Ptr);
end if;
else
-- symbol (True or False)
-- Handle True or False
else
if Evaluation then
Symbol1 := Index_Of (Symbol_Name1);
@ -674,6 +685,8 @@ package body Prep is
end if;
end if;
-- Unrecognized sequence
when others =>
Error_Msg ("`(`, NOT or symbol expected", Token_Ptr);
end case;
@ -691,7 +704,7 @@ package body Prep is
Final_Result := Final_Result and Current_Result;
end case;
-- Check the next operator
-- Handle AND
if Token = Tok_And then
if Complemented then
@ -714,6 +727,8 @@ package body Prep is
end if;
end if;
-- Handle OR
elsif Token = Tok_Or then
if Complemented then
Error_Msg
@ -735,9 +750,9 @@ package body Prep is
end if;
end if;
else
-- No operator: exit the term loop
-- No AND/OR operator, so exit from the loop through terms
else
exit;
end if;
end loop;
@ -824,7 +839,6 @@ package body Prep is
Get_Name_String (Mapping.Table (Order (Op1)).Symbol);
S2 : constant String :=
Get_Name_String (Mapping.Table (Order (Op2)).Symbol);
begin
return S1 < S2;
end Lt;
@ -961,6 +975,8 @@ package body Prep is
-- Parse_Def_File --
--------------------
-- This procedure REALLY needs some more comments ???
procedure Parse_Def_File is
Symbol : Symbol_Id;
Symbol_Name : Name_Id;
@ -1012,7 +1028,6 @@ package body Prep is
begin
Start_String;
while Ptr < Scan_Ptr loop
Store_String_Char (Sinput.Source (Ptr));
Ptr := Ptr + 1;
@ -1102,9 +1117,10 @@ package body Prep is
Symbol := Index_Of (Symbol_Name);
if Symbol /= No_Symbol then
-- If we already have an entry for this symbol, replace it
-- with the new value, except if the symbol was declared
-- on the command line.
-- with the new value, except if the symbol was declared on
-- the command line.
if Mapping.Table (Symbol).On_The_Command_Line then
goto Continue;
@ -1299,8 +1315,8 @@ package body Prep is
Scan.all;
end if;
-- It is an error to have trailing characters after
-- the condition or "then".
-- It is an error to have trailing characters after the
-- condition or "then".
if Token /= Tok_End_Of_Line
and then Token /= Tok_EOF
@ -1313,8 +1329,9 @@ package body Prep is
Go_To_End_Of_Line;
end if;
-- Depending on the value of the condition, set the
-- new values of Deleting and Match_Seen.
-- Depending on the value of the condition, set the new
-- values of Deleting and Match_Seen.
if Pp_States.Last > 0 then
if Pp_States.Table (Pp_States.Last).Match_Seen then
Pp_States.Table (Pp_States.Last).Deleting := True;
@ -1343,8 +1360,7 @@ package body Prep is
No_Error_Found := False;
end if;
-- Set the possibly new values of Deleting and
-- Match_Seen.
-- Set the possibly new values of Deleting and Match_Seen
if Pp_States.Last > 0 then
if Pp_States.Table (Pp_States.Last).Match_Seen then
@ -1358,8 +1374,7 @@ package body Prep is
False;
end if;
-- Set the Else_Ptr to check for illegal #elsif
-- later.
-- Set the Else_Ptr to check for illegal #elsif later
Pp_States.Table (Pp_States.Last).Else_Ptr :=
Token_Ptr;
@ -1367,7 +1382,8 @@ package body Prep is
Scan.all;
-- It is an error to have characters after "#else"
-- Error of character present after "#else"
if Token /= Tok_End_Of_Line
and then Token /= Tok_EOF
then
@ -1404,8 +1420,8 @@ package body Prep is
else
Scan.all;
-- It is an error to have character after
-- "#end if;".
-- Error of character present after "#end if;"
if Token /= Tok_End_Of_Line
and then Token /= Tok_EOF
then
@ -1535,15 +1551,14 @@ package body Prep is
pragma Assert (Token = Tok_End_Of_Line or else Token = Tok_EOF);
-- At this point, the token is either end of line or EOF.
-- The line to possibly output stops just before the token.
-- At this point, the token is either end of line or EOF. The line to
-- possibly output stops just before the token.
Output_Line (Start_Of_Processing, Token_Ptr - 1);
-- If we are at the end of a line, the scan pointer is at the first
-- non blank character, not necessarily the first character of the
-- line; so, we have to deduct Start_Of_Processing from the token
-- pointer.
-- non-blank character (may not be the first character of the line),
-- so we have to deduct Start_Of_Processing from the token pointer.
if Token = Tok_End_Of_Line then
if (Sinput.Source (Token_Ptr) = ASCII.CR

26
gcc/ada/prj-nmsc.adb
View File

@ -2716,7 +2716,8 @@ package body Prj.Nmsc is
Other : Source_Id;
Unit_Found : Boolean;
Interface_ALIs : String_List_Id := Nil_String;
Interface_ALIs : String_List_Id := Nil_String;
Other_Interfaces : String_List_Id := Nil_String;
begin
if not Interfaces.Default then
@ -2771,6 +2772,8 @@ package body Prj.Nmsc is
Other.Declared_In_Interfaces := True;
end if;
-- Unit based case
if Source.Language.Config.Kind = Unit_Based then
if Source.Kind = Spec
and then Other_Part (Source) /= No_Source
@ -2794,6 +2797,26 @@ package body Prj.Nmsc is
Interface_ALIs :=
String_Element_Table.Last
(Shared.String_Elements);
-- File based case
else
String_Element_Table.Increment_Last
(Shared.String_Elements);
Shared.String_Elements.Table
(String_Element_Table.Last
(Shared.String_Elements)) :=
(Value => Name_Id (Source.File),
Index => 0,
Display_Value => Name_Id (Source.Display_File),
Location => No_Location,
Flag => False,
Next => Other_Interfaces);
Other_Interfaces :=
String_Element_Table.Last
(Shared.String_Elements);
end if;
Debug_Output
@ -2825,6 +2848,7 @@ package body Prj.Nmsc is
Project.Interfaces_Defined := True;
Project.Lib_Interface_ALIs := Interface_ALIs;
Project.Other_Interfaces := Other_Interfaces;
elsif Project.Library and then not Library_Interface.Default then

36
gcc/ada/prj.ads
View File

@ -165,8 +165,8 @@ package Prj is
-- The defined kinds of variables
Ignored : constant Variable_Kind;
-- Used to indicate that a package declaration must be ignored
-- while processing the project tree (unknown package name).
-- Used to indicate that a package declaration must be ignored while
-- processing the project tree (unknown package name).
type Variable_Value (Kind : Variable_Kind := Undefined) is record
Project : Project_Id := No_Project;
@ -262,7 +262,7 @@ package Prj is
Attributes => No_Variable,
Arrays => No_Array,
Packages => No_Package);
-- Default value of Declarations: indicates that there is no declarations
-- Default value of Declarations: used if there are no declarations
type Package_Element is record
Name : Name_Id := No_Name;
@ -435,8 +435,8 @@ package Prj is
function Other_Part (Source : Source_Id) return Source_Id;
pragma Inline (Other_Part);
-- Source ID for the other part, if any: for a spec, indicates its body;
-- for a body, indicates its spec.
-- Source ID for the other part, if any: for a spec, returns its body;
-- for a body, returns its spec.
No_Source : constant Source_Id := null;
@ -595,9 +595,9 @@ package Prj is
-- spec pattern.
Config_File_Unique : Boolean := False;
-- Indicate if the config file specified to the compiler needs to be
-- unique. If it is unique, then all config files are concatenated into
-- a temp config file.
-- True if the config file specified to the compiler needs to be unique.
-- If it is unique, then all config files are concatenated into a temp
-- config file.
Binder_Driver : File_Name_Type := No_File;
-- The name of the binder driver for the language, if any
@ -1345,19 +1345,20 @@ package Prj is
-- Indicate that this is a Standalone Library Project File
Lib_Interface_ALIs : String_List_Id := Nil_String;
-- For Standalone Library Project Files, indicate the list of Interface
-- ALI files.
-- For Standalone Library Project Files, list of Interface ALI files.
Other_Interfaces : String_List_Id := Nil_String;
-- List of non unit based sources in attribute Interfaces
Lib_Auto_Init : Boolean := False;
-- For non static Stand-Alone Library Project Files, indicate if
-- the library initialisation should be automatic.
-- For non static Stand-Alone Library Project Files, True if the library
-- initialisation should be automatic.
Symbol_Data : Symbol_Record := No_Symbols;
-- Symbol file name, reference symbol file name, symbol policy
Need_To_Build_Lib : Boolean := False;
-- Indicates that the library of a Library Project needs to be built or
-- rebuilt.
-- True if the library of a Library Project needs to be built or rebuilt
-------------
-- Sources --
@ -1415,8 +1416,8 @@ package Prj is
-- The path name of the configuration pragmas file, if any
Config_File_Temp : Boolean := False;
-- An indication that the configuration pragmas file is a temporary file
-- that must be deleted at the end.
-- True if the configuration pragmas file is a temporary file that must
-- be deleted at the end.
Config_Checked : Boolean := False;
-- A flag to avoid checking repetitively the configuration pragmas file
@ -1972,8 +1973,7 @@ private
-- setting the env var to the same value. When different from No_Path,
-- this indicates that logical names (VMS) or environment variables were
-- created and should be deassigned to avoid polluting the environment
-- on VMS.
-- gnatmake only
-- on VMS. This is for gnatmake only.
Current_Object_Path_File : Path_Name_Type := No_Path;
-- Current value of project object path file env var. Used to avoid

26
gcc/ada/s-valuti.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2013, 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- --
@ -134,9 +134,9 @@ package body System.Val_Util is
-- Scan out the exponent value as an unsigned integer. Values larger
-- than (Integer'Last / 10) are simply considered large enough here.
-- This assumption is correct for all machines we know of (e.g. in
-- the case of 16 bit integers it allows exponents up to 3276, which
-- is large enough for the largest floating types in base 2.)
-- This assumption is correct for all machines we know of (e.g. in the
-- case of 16 bit integers it allows exponents up to 3276, which is
-- large enough for the largest floating types in base 2.)
X := 0;
@ -222,8 +222,8 @@ package body System.Val_Util is
P : Natural := Ptr.all;
begin
-- Deal with case of null string (all blanks!). As per spec, we
-- raise constraint error, with Ptr unchanged, and thus > Max.
-- Deal with case of null string (all blanks!). As per spec, we raise
-- constraint error, with Ptr unchanged, and thus > Max.
if P > Max then
Bad_Value (Str);
@ -300,16 +300,16 @@ package body System.Val_Util is
begin
P := P + 1;
-- If underscore is at the end of string, then this is an error and
-- we raise Constraint_Error, leaving the pointer past the underscore.
-- This seems a bit strange. It means e.g. that if the field is:
-- If underscore is at the end of string, then this is an error and we
-- raise Constraint_Error, leaving the pointer past the underscore. This
-- seems a bit strange. It means e.g. that if the field is:
-- 345_
-- that Constraint_Error is raised. You might think that the RM in
-- this case would scan out the 345 as a valid integer, leaving the
-- pointer at the underscore, but the ACVC suite clearly requires
-- an error in this situation (see for example CE3704M).
-- that Constraint_Error is raised. You might think that the RM in this
-- case would scan out the 345 as a valid integer, leaving the pointer
-- at the underscore, but the ACVC suite clearly requires an error in
-- this situation (see for example CE3704M).
if P > Max then
Ptr.all := P;

10
gcc/ada/scng.adb
View File

@ -592,14 +592,12 @@ package body Scng is
-- which the digit was expected on input, and is unchanged on return.
procedure Scan_Integer;
-- Procedure to scan integer literal. On entry, Scan_Ptr points to a
-- digit, on exit Scan_Ptr points past the last character of the
-- integer.
-- Scan integer literal. On entry, Scan_Ptr points to a digit, on
-- exit Scan_Ptr points past the last character of the integer.
--
-- For each digit encountered, UI_Int_Value is multiplied by 10, and
-- the value of the digit added to the result. In addition, the
-- value in Scale is decremented by one for each actual digit
-- scanned.
-- the value of the digit added to the result. In addition, the value
-- in Scale is decremented by one for each actual digit scanned.
--------------------------
-- Error_Digit_Expected --

18
gcc/ada/sem_prag.adb
View File

@ -16162,16 +16162,24 @@ package body Sem_Prag is
Set_Main_Priority
(Current_Sem_Unit, UI_To_Int (Expr_Value (Arg)));
-- Load an arbitrary entity from System.Tasking to make sure
-- this package is implicitly with'ed, since we need to have
-- the tasking run-time active for the pragma Priority to have
-- any effect.
-- Load an arbitrary entity from System.Tasking.Stages or
-- System.Tasking.Restricted.Stages (depending on the
-- supported profile) to make sure that one of these packages
-- is implicitly with'ed, since we need to have the tasking
-- run time active for the pragma Priority to have any effect.
-- Previously with with'ed the package System.Tasking, but
-- this package does not trigger the required initialization
-- of the run-time library.
declare
Discard : Entity_Id;
pragma Warnings (Off, Discard);
begin
Discard := RTE (RE_Task_List);
if Restricted_Profile then
Discard := RTE (RE_Activate_Restricted_Tasks);
else
Discard := RTE (RE_Activate_Tasks);
end if;
end;
-- Task or Protected, must be of type Integer