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

[multiple changes] 

2012-10-04  Robert Dewar  <dewar@adacore.com>

	* sem_eval.adb (Fold_Str, Fold_Uint, Fold_Ureal): Reset static
	expression state after Resolve call.

2012-10-04  Robert Dewar  <dewar@adacore.com>

	* sem_prag.adb (Analyze_Pragma. case Warnngs): Don't make entry
	in the table for Warnings Off pragmas if within an instance.

2012-10-04  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch9.adb (Analyze_Entry_Body): Transfer
	Has_Pragma_Unreferenced flag from entry formal to corresponding
	entity in body, to prevent spurious warnings when pragma is
	present.

2012-10-04  Robert Dewar  <dewar@adacore.com>

	* s-bignum.adb (Big_Exp): Raise Storage_Error for ludicrously
	large results.

2012-10-04  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch3.adb (Check_Duplicate_Aspects): Diagnose properly
	aspects that appear in the partial and the full view of a type.

2012-10-04  Robert Dewar  <dewar@adacore.com>

	* sinfo.ads (N_Return_Statement): Removed.

2012-10-04  Tristan Gingold  <gingold@adacore.com>

	* init.c (__gl_zero_cost_exceptions): Comment it as not used
	anymore.
	* bindgen.adb (Gen_Adainit): Do not emit Zero_Cost_Exceptions
	anymore.

2012-10-04  Thomas Quinot  <quinot@adacore.com>

	* prep.adb, prepcomp.adb, gprep.adb, opt.ads: New preprocessor switch
	-a (all source text preserved).

From-SVN: r192072
This commit is contained in:
Arnaud Charlet 2012-10-04 11:18:55 +02:00
parent 65f7ed64ca
commit 9479ded447
13 changed files with 173 additions and 53 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

43
gcc/ada/ChangeLog
View File

@ -1,3 +1,46 @@
2012-10-04 Robert Dewar <dewar@adacore.com>
* sem_eval.adb (Fold_Str, Fold_Uint, Fold_Ureal): Reset static
expression state after Resolve call.
2012-10-04 Robert Dewar <dewar@adacore.com>
* sem_prag.adb (Analyze_Pragma. case Warnngs): Don't make entry
in the table for Warnings Off pragmas if within an instance.
2012-10-04 Ed Schonberg <schonberg@adacore.com>
* sem_ch9.adb (Analyze_Entry_Body): Transfer
Has_Pragma_Unreferenced flag from entry formal to corresponding
entity in body, to prevent spurious warnings when pragma is
present.
2012-10-04 Robert Dewar <dewar@adacore.com>
* s-bignum.adb (Big_Exp): Raise Storage_Error for ludicrously
large results.
2012-10-04 Ed Schonberg <schonberg@adacore.com>
* sem_ch3.adb (Check_Duplicate_Aspects): Diagnose properly
aspects that appear in the partial and the full view of a type.
2012-10-04 Robert Dewar <dewar@adacore.com>
* sinfo.ads (N_Return_Statement): Removed.
2012-10-04 Tristan Gingold <gingold@adacore.com>
* init.c (__gl_zero_cost_exceptions): Comment it as not used
anymore.
* bindgen.adb (Gen_Adainit): Do not emit Zero_Cost_Exceptions
anymore.
2012-10-04 Thomas Quinot <quinot@adacore.com>
* prep.adb, prepcomp.adb, gprep.adb, opt.ads: New preprocessor switch
-a (all source text preserved).
2012-10-04 Vincent Celier <celier@adacore.com>
* prj-proc.adb (Recursive_Process): Use project directory

18
gcc/ada/bindgen.adb
View File

@ -137,7 +137,6 @@ package body Bindgen is
-- Num_Interrupt_States : Integer;
-- Unreserve_All_Interrupts : Integer;
-- Exception_Tracebacks : Integer;
-- Zero_Cost_Exceptions : Integer;
-- Detect_Blocking : Integer;
-- Default_Stack_Size : Integer;
-- Leap_Seconds_Support : Integer;
@ -216,9 +215,6 @@ package body Bindgen is
-- tracebacks are provided by default, so a value of zero for this
-- parameter does not necessarily mean no trace backs are available.
-- Zero_Cost_Exceptions is set to one if zero cost exceptions are used for
-- this partition, and to zero if longjmp/setjmp exceptions are used.
-- Detect_Blocking indicates whether pragma Detect_Blocking is active or
-- not. A value of zero indicates that the pragma is not present, while a
-- value of 1 signals its presence in the partition.
@ -607,9 +603,6 @@ package body Bindgen is
"""__gl_exception_tracebacks"");");
end if;
WBI (" Zero_Cost_Exceptions : Integer;");
WBI (" pragma Import (C, Zero_Cost_Exceptions, " &
"""__gl_zero_cost_exceptions"");");
WBI (" Detect_Blocking : Integer;");
WBI (" pragma Import (C, Detect_Blocking, " &
"""__gl_detect_blocking"");");
@ -803,17 +796,6 @@ package body Bindgen is
WBI (" Exception_Tracebacks := 1;");
end if;
Set_String (" Zero_Cost_Exceptions := ");
if Zero_Cost_Exceptions_Specified then
Set_String ("1");
else
Set_String ("0");
end if;
Set_String (";");
Write_Statement_Buffer;
Set_String (" Detect_Blocking := ");
if Detect_Blocking then

8
gcc/ada/gprep.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2002-2011, Free Software Foundation, Inc. --
-- Copyright (C) 2002-2012, 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- --
@ -720,7 +720,7 @@ package body GPrep is
loop
begin
Switch := GNAT.Command_Line.Getopt ("D: b c C r s T u v");
Switch := GNAT.Command_Line.Getopt ("D: a b c C r s T u v");
case Switch is
@ -731,6 +731,10 @@ package body GPrep is
Process_Command_Line_Symbol_Definition
(S => GNAT.Command_Line.Parameter);
when 'a' =>
Opt.No_Deletion := True;
Opt.Undefined_Symbols_Are_False := True;
when 'b' =>
Opt.Blank_Deleted_Lines := True;

4
gcc/ada/init.c
View File

@ -103,12 +103,14 @@ char *__gl_interrupt_states = 0;
int __gl_num_interrupt_states = 0;
int __gl_unreserve_all_interrupts = 0;
int __gl_exception_tracebacks = 0;
int __gl_zero_cost_exceptions = 0;
int __gl_detect_blocking = 0;
int __gl_default_stack_size = -1;
int __gl_leap_seconds_support = 0;
int __gl_canonical_streams = 0;
/* This value is not used anymore, but kept for bootstrapping purpose. */
int __gl_zero_cost_exceptions = 0;
/* Indication of whether synchronous signal handler has already been
installed by a previous call to adainit. */
int __gnat_handler_installed = 0;

6
gcc/ada/opt.ads
View File

@ -968,6 +968,12 @@ package Opt is
-- in this variable (e.g. 2 = select second unit in file). A value of
-- zero indicates that we are in normal (one unit per file) mode.
No_Deletion : Boolean := False;
-- GNATPREP
-- Set by preprocessor switch -a. Do not eliminate any source text. Implies
-- Undefined_Symbols_Are_False. Useful to perform a syntax check on all
-- branches of #if constructs.
No_Main_Subprogram : Boolean := False;
-- GNATMAKE, GNATBIND
-- Set to True if compilation/binding of a program without main

8
gcc/ada/prep.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2002-2010, Free Software Foundation, Inc. --
-- Copyright (C) 2002-2012, 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- --
@ -292,8 +292,8 @@ package body Prep is
Result.Value := End_String;
end if;
-- Now, check the syntax of the symbol (we don't allow accented and
-- wide characters)
-- Now, check the syntax of the symbol (we don't allow accented or
-- wide characters).
if Name_Buffer (1) not in 'a' .. 'z'
and then Name_Buffer (1) not in 'A' .. 'Z'
@ -356,7 +356,7 @@ package body Prep is
begin
-- Always return False when not inside an #if statement
if Pp_States.Last = Ground then
if Opt.No_Deletion or else Pp_States.Last = Ground then
return False;
else
return Pp_States.Table (Pp_States.Last).Deleting;

18
gcc/ada/prepcomp.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2003-2010, Free Software Foundation, Inc. --
-- Copyright (C) 2003-2012, 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- --
@ -60,6 +60,7 @@ package body Prepcomp is
Undef_False : Boolean := False;
Always_Blank : Boolean := False;
Comments : Boolean := False;
No_Deletion : Boolean := False;
List_Symbols : Boolean := False;
Processed : Boolean := False;
end record;
@ -73,6 +74,7 @@ package body Prepcomp is
Undef_False => False,
Always_Blank => False,
Comments => False,
No_Deletion => False,
List_Symbols => False,
Processed => False);
@ -330,6 +332,16 @@ package body Prepcomp is
-- significant.
case Sinput.Source (Token_Ptr) is
when 'a' =>
-- All source text preserved (also implies -u)
if Name_Len = 1 then
Current_Data.No_Deletion := True;
Current_Data.Undef_False := True;
OK := True;
end if;
when 'u' =>
-- Undefined symbol are False
@ -581,15 +593,15 @@ package body Prepcomp is
-- Set the preprocessing flags according to the preprocessing data
if Current_Data.Comments and then not Current_Data.Always_Blank then
if Current_Data.Comments and not Current_Data.Always_Blank then
Comment_Deleted_Lines := True;
Blank_Deleted_Lines := False;
else
Comment_Deleted_Lines := False;
Blank_Deleted_Lines := True;
end if;
No_Deletion := Current_Data.No_Deletion;
Undefined_Symbols_Are_False := Current_Data.Undef_False;
List_Preprocessing_Symbols := Current_Data.List_Symbols;

11
gcc/ada/s-bignum.adb
View File

@ -341,6 +341,17 @@ package body System.Bignums is
begin
Free_Bignum (XY2);
-- Raise storage error if intermediate value is getting too
-- large, which we arbitrarily define as 200 words for now!
if XY2S.Len > 200 then
Free_Bignum (XY2S);
raise Storage_Error with
"exponentiation result is too large";
end if;
-- Otherwise take care of even/odd cases
if (Y and 1) = 0 then
return XY2S;

42
gcc/ada/sem_ch3.adb
View File

@ -23,6 +23,7 @@
-- --
------------------------------------------------------------------------------
with Aspects; use Aspects;
with Atree; use Atree;
with Checks; use Checks;
with Debug; use Debug;
@ -14805,6 +14806,11 @@ package body Sem_Ch3 is
New_Id : Entity_Id;
Prev_Par : Node_Id;
procedure Check_Duplicate_Aspects;
-- Check that aspects specified in a completion have not been specified
-- already in the partial view. Type_Invariant and others can be
-- specified on either view but never on both.
procedure Tag_Mismatch;
-- Diagnose a tagged partial view whose full view is untagged.
-- We post the message on the full view, with a reference to
@ -14813,6 +14819,38 @@ package body Sem_Ch3 is
-- so we determine the position of the error message from the
-- respective slocs of both.
-----------------------------
-- Check_Duplicate_Aspects --
-----------------------------
procedure Check_Duplicate_Aspects is
Prev_Aspects : constant List_Id := Aspect_Specifications (Prev_Par);
Full_Aspects : constant List_Id := Aspect_Specifications (N);
F_Spec, P_Spec : Node_Id;
begin
if Present (Prev_Aspects) and then Present (Full_Aspects) then
F_Spec := First (Full_Aspects);
while Present (F_Spec) loop
P_Spec := First (Prev_Aspects);
while Present (P_Spec) loop
if
Chars (Identifier (P_Spec)) = Chars (Identifier (F_Spec))
then
Error_Msg_N
("aspect already specified in private declaration",
F_Spec);
Remove (F_Spec);
return;
end if;
Next (P_Spec);
end loop;
Next (F_Spec);
end loop;
end if;
end Check_Duplicate_Aspects;
------------------
-- Tag_Mismatch --
------------------
@ -15022,6 +15060,10 @@ package body Sem_Ch3 is
("declaration of full view must appear in private part", N);
end if;
if Ada_Version >= Ada_2012 then
Check_Duplicate_Aspects;
end if;
Copy_And_Swap (Prev, Id);
Set_Has_Private_Declaration (Prev);
Set_Has_Private_Declaration (Id);

8
gcc/ada/sem_ch9.adb
View File

@ -1345,9 +1345,10 @@ package body Sem_Ch9 is
-- Check for unreferenced variables etc. Before the Check_References
-- call, we transfer Never_Set_In_Source and Referenced flags from
-- parameters in the spec to the corresponding entities in the body,
-- since we want the warnings on the body entities. Note that we do
-- not have to transfer Referenced_As_LHS, since that flag can only
-- be set for simple variables.
-- since we want the warnings on the body entities. Note that we do not
-- have to transfer Referenced_As_LHS, since that flag can only be set
-- for simple variables, but we include Has_Pragma_Unreferenced,
-- which may have been specified for a formal in the body.
-- At the same time, we set the flags on the spec entities to suppress
-- any warnings on the spec formals, since we also scan the spec.
@ -1382,6 +1383,7 @@ package body Sem_Ch9 is
Set_Referenced (E2, Referenced (E1));
Set_Referenced (E1);
Set_Has_Pragma_Unreferenced (E2, Has_Pragma_Unreferenced (E1));
Set_Entry_Component (E2, Entry_Component (E1));
<<Continue>>

40
gcc/ada/sem_eval.adb
View File

@ -199,7 +199,7 @@ package body Sem_Eval is
-- Tests to see if expression N whose single operand is Op1 is foldable,
-- i.e. the operand value is known at compile time. If the operation is
-- foldable, then Fold is True on return, and Stat indicates whether
-- the result is static (i.e. both operands were static). Note that it
-- the result is static (i.e. the operand was static). Note that it
-- is quite possible for Fold to be True, and Stat to be False, since
-- there are cases in which we know the value of an operand even though
-- it is not technically static (e.g. the static lower bound of a range
@ -233,7 +233,7 @@ package body Sem_Eval is
Stat : out Boolean;
Fold : out Boolean);
-- Same processing, except applies to an expression N with two operands
-- Op1 and Op2.
-- Op1 and Op2. The result is static only if both operands are static.
function Test_In_Range
(N : Node_Id;
@ -241,11 +241,11 @@ package body Sem_Eval is
Assume_Valid : Boolean;
Fixed_Int : Boolean;
Int_Real : Boolean) return Range_Membership;
-- Common processing for Is_In_Range and Is_Out_Of_Range:
-- Returns In_Range or Out_Of_Range if it can be guaranteed at compile time
-- that expression N is known to be in or out of range of the subtype Typ.
-- If not compile time known, Unknown is returned.
-- See documentation of Is_In_Range for complete description of parameters.
-- Common processing for Is_In_Range and Is_Out_Of_Range: Returns In_Range
-- or Out_Of_Range if it can be guaranteed at compile time that expression
-- N is known to be in or out of range of the subtype Typ. If not compile
-- time known, Unknown is returned. See documentation of Is_In_Range for
-- complete description of parameters.
procedure To_Bits (U : Uint; B : out Bits);
-- Converts a Uint value to a bit string of length B'Length
@ -4046,12 +4046,18 @@ package body Sem_Eval is
-- We now have the literal with the right value, both the actual type
-- and the expected type of this literal are taken from the expression
-- that was evaluated.
-- that was evaluated. So now we do the Analyze and Resolve.
-- Note that we have to reset Is_Static_Expression both after the
-- analyze step (because Resolve will evaluate the literal, which
-- will cause semantic errors if it is marked as static), and after
-- the Resolve step (since Resolve in some cases sets this flag).
Analyze (N);
Set_Is_Static_Expression (N, Static);
Set_Etype (N, Typ);
Resolve (N);
Set_Is_Static_Expression (N, Static);
end Fold_Str;
---------------
@ -4100,12 +4106,18 @@ package body Sem_Eval is
-- We now have the literal with the right value, both the actual type
-- and the expected type of this literal are taken from the expression
-- that was evaluated.
-- that was evaluated. So now we do the Analyze and Resolve.
-- Note that we have to reset Is_Static_Expression both after the
-- analyze step (because Resolve will evaluate the literal, which
-- will cause semantic errors if it is marked as static), and after
-- the Resolve step (since Resolve in some cases sets this flag).
Analyze (N);
Set_Is_Static_Expression (N, Static);
Set_Etype (N, Typ);
Resolve (N);
Set_Is_Static_Expression (N, Static);
end Fold_Uint;
----------------
@ -4135,12 +4147,20 @@ package body Sem_Eval is
Set_Original_Entity (N, Ent);
-- Both the actual and expected type comes from the original expression
-- We now have the literal with the right value, both the actual type
-- and the expected type of this literal are taken from the expression
-- that was evaluated. So now we do the Analyze and Resolve.
-- Note that we have to reset Is_Static_Expression both after the
-- analyze step (because Resolve will evaluate the literal, which
-- will cause semantic errors if it is marked as static), and after
-- the Resolve step (since Resolve in some cases sets this flag).
Analyze (N);
Set_Is_Static_Expression (N, Static);
Set_Etype (N, Typ);
Resolve (N);
Set_Is_Static_Expression (N, Static);
end Fold_Ureal;
---------------

9
gcc/ada/sem_prag.adb
View File

@ -14802,10 +14802,17 @@ package body Sem_Prag is
loop
Set_Warnings_Off
(E, (Chars (Get_Pragma_Arg (Arg1)) =
Name_Off));
Name_Off));
-- For OFF case, make entry in warnings off
-- pragma table for later processing. But we do
-- not do that within an instance, since these
-- warnings are about what is needed in the
-- template, not an instance of it.
if Chars (Get_Pragma_Arg (Arg1)) = Name_Off
and then Warn_On_Warnings_Off
and then not In_Instance
then
Warnings_Off_Pragmas.Append ((N, E));
end if;

11
gcc/ada/sinfo.ads
View File

@ -12419,15 +12419,4 @@ package Sinfo is
pragma Inline (Set_Was_Originally_Stub);
pragma Inline (Set_Withed_Body);
--------------
-- Synonyms --
--------------
-- These synonyms are to aid in transition, they should eventually be
-- removed when all remaining references to the obsolete name are gone.
N_Return_Statement : constant Node_Kind := N_Simple_Return_Statement;
-- Rename N_Simple_Return_Statement to be N_Return_Statement. Clients
-- should refer to N_Simple_Return_Statement.
end Sinfo;