+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.
#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>
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 (" ");
@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}
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.
@smallexample
@group
-#if DEBUG or PRIORITY > 4 then
+#if DEBUG or else (PRIORITY > 4) then
bunch of declarations
#else
completely different bunch of declarations
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;
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)
-- If no character '=', then the value is True
if Index = 0 then
+
-- Put the symbol in the name buffer
Name_Len := Definition'Length;
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;
Current_Result := False;
- case Token is
+ -- Scan current term, starting with Token
- when Tok_Left_Paren =>
+ case Token is
- -- ( expression )
+ -- Handle parenthesized expression
+ when Tok_Left_Paren =>
Scan.all;
Current_Result := Expression (Evaluation);
("`)` expected", Token_Ptr);
end if;
- when Tok_Not =>
-
- -- not expression
+ -- Handle not expression
+ when Tok_Not =>
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;
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;
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);
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;
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
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;
Token_Ptr);
end if;
- else
- -- symbol (True or False)
+ -- Handle True or False
+ else
if Evaluation then
Symbol1 := Index_Of (Symbol_Name1);
end if;
end if;
+ -- Unrecognized sequence
+
when others =>
Error_Msg ("`(`, NOT or symbol expected", Token_Ptr);
end case;
Final_Result := Final_Result and Current_Result;
end case;
- -- Check the next operator
+ -- Handle AND
if Token = Tok_And then
if Complemented then
end if;
end if;
+ -- Handle OR
+
elsif Token = Tok_Or then
if Complemented then
Error_Msg
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;
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;
-- Parse_Def_File --
--------------------
+ -- This procedure REALLY needs some more comments ???
+
procedure Parse_Def_File is
Symbol : Symbol_Id;
Symbol_Name : Name_Id;
begin
Start_String;
-
while Ptr < Scan_Ptr loop
Store_String_Char (Sinput.Source (Ptr));
Ptr := Ptr + 1;
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;
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
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;
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
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;
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
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
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
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
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
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
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
-- 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;
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;
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;
-- 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
-- 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 --
-- 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
-- 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
-- --
-- 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- --
-- 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;
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);
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;
-- 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 --
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
projects / thirdparty / gcc.git / commitdiff
