procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

[multiple changes]

Browse source 
2013-02-06  Javier Miranda  <miranda@adacore.com>

	* exp_ch5.adb (Expand_N_Assignment_Statement): Do not generate the
	runtime check on assignment to tagged types if compiling with checks
	suppressed.

2013-02-06  Robert Dewar  <dewar@adacore.com>

	* exp_util.adb, checks.adb, sem_ch12.adb, sem_res.adb, prj-conf.adb,
	s-os_lib.adb: Minor reformatting

2013-02-06  Vincent Celier  <celier@adacore.com>

	* ug_words: Add -gnateY = /IGNORE_STYLE_CHECKS_PRAGMAS.

2013-02-06  Ed Schonberg  <schonberg@adacore.com>

	* snames.ads-tmpl: Add Name_Rational and pragma Rational.
	* par-prag.adb: Recognize pragma Rational.
	* opt.ads (Rational_Profile): flag to control compatibility mode
	with Rational compiler.
	* sem_ch8.adb (Analyze_Subprogram_Renaming): When Rational profile
	is enable, accept renaming declarations where the new subprogram
	and the renamed entity have the same name.
	* sem_prag.adb (analyze_pragma): Add pragma Rational, and recognize
	Rational as a profile.

From-SVN: r195793
This commit is contained in:
Arnaud Charlet 2013-02-06 11:24:21 +01:00
parent ba08ba8412
commit c91dbd184b
14 changed files with 103 additions and 45 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

27
gcc/ada/ChangeLog
View file

@ -1,3 +1,30 @@
2013-02-06 Javier Miranda <miranda@adacore.com>
* exp_ch5.adb (Expand_N_Assignment_Statement): Do not generate the
runtime check on assignment to tagged types if compiling with checks
suppressed.
2013-02-06 Robert Dewar <dewar@adacore.com>
* exp_util.adb, checks.adb, sem_ch12.adb, sem_res.adb, prj-conf.adb,
s-os_lib.adb: Minor reformatting
2013-02-06 Vincent Celier <celier@adacore.com>
* ug_words: Add -gnateY = /IGNORE_STYLE_CHECKS_PRAGMAS.
2013-02-06 Ed Schonberg <schonberg@adacore.com>
* snames.ads-tmpl: Add Name_Rational and pragma Rational.
* par-prag.adb: Recognize pragma Rational.
* opt.ads (Rational_Profile): flag to control compatibility mode
with Rational compiler.
* sem_ch8.adb (Analyze_Subprogram_Renaming): When Rational profile
is enable, accept renaming declarations where the new subprogram
and the renamed entity have the same name.
* sem_prag.adb (analyze_pragma): Add pragma Rational, and recognize
Rational as a profile.
2013-02-06 Hristian Kirtchev <kirtchev@adacore.com>
* exp_ch5.adb (Expand_Loop_Entry_Attributes): When

12
gcc/ada/checks.adb
View file

@ -1536,9 +1536,9 @@ package body Checks is
-- the constraints are constants. In this case, we can do the check
-- successfully at compile time.
-- We skip this check for the case where the node is a rewritten`as
-- an allocator, because it already carries the context subtype, and
-- extracting the discriminants from the aggregate is messy.
-- We skip this check for the case where the node is rewritten`as
-- an allocator, because it already carries the context subtype,
-- and extracting the discriminants from the aggregate is messy.
if Is_Constrained (S_Typ)
and then Nkind (Original_Node (N)) /= N_Allocator
@ -1596,11 +1596,11 @@ package body Checks is
if Ekind (T_Typ) = E_Private_Subtype
and then Present (Full_View (T_Typ))
then
DconT :=
DconT :=
First_Elmt (Discriminant_Constraint (Full_View (T_Typ)));
else
DconT := First_Elmt (Discriminant_Constraint (T_Typ));
DconT :=
First_Elmt (Discriminant_Constraint (T_Typ));
end if;
while Present (Discr) loop

3
gcc/ada/exp_ch5.adb
View file

@ -2476,7 +2476,8 @@ package body Exp_Ch5 is
-- the assignment we generate run-time check to ensure that
-- the tags of source and target match.
if Is_Class_Wide_Type (Typ)
if not Tag_Checks_Suppressed (Typ)
and then Is_Class_Wide_Type (Typ)
and then Is_Tagged_Type (Typ)
and then Is_Tagged_Type (Underlying_Type (Etype (Rhs)))
then

6
gcc/ada/exp_util.adb
View file

@ -7952,9 +7952,9 @@ package body Exp_Util is
Par : Node_Id;
begin
-- Locate an enclosing case or if expression. Note that these constructs
-- appear as expression_with_actions, hence the test using the original
-- node.
-- Locate an enclosing case or if expression. Note: these constructs can
-- get expanded into Expression_With_Actions, hence the need to test
-- using the original node.
Par := N;
while Present (Par) loop

4
gcc/ada/opt.ads
View file

@ -1181,6 +1181,10 @@ package Opt is
-- Set to True if the tool should not have any output if there are no
-- errors or warnings.
Rational_Profile : Boolean := False;
-- GNAT
-- Set to True to enable compatibility mode with Rational compiler.
Replace_In_Comments : Boolean := False;
-- GNATPREP
-- Set to True if -C switch used

3
gcc/ada/par-prag.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- --
@ -1245,6 +1245,7 @@ begin
Pragma_Remote_Call_Interface |
Pragma_Remote_Types |
Pragma_Restricted_Run_Time |
Pragma_Rational |
Pragma_Ravenscar |
Pragma_Reviewable |
Pragma_Share_Generic |

13
gcc/ada/prj-conf.adb
View file

@ -1629,9 +1629,8 @@ package body Prj.Conf is
Success : Boolean;
Conf_Project : Project_Id := No_Project;
-- The object directory of this project will be used to store the config
-- project file in auto-configuration. Set by procedure Check_Project
-- below.
-- The object directory of this project is used to store the config
-- project file in auto-configuration. Set by Check_Project below.
procedure Check_Project (Project : Project_Id);
-- Look for a non aggregate project. If one is found, put its project Id
@ -1644,11 +1643,11 @@ package body Prj.Conf is
procedure Check_Project (Project : Project_Id) is
begin
if Project.Qualifier = Aggregate
or else Project.Qualifier = Aggregate_Library
or else
Project.Qualifier = Aggregate_Library
then
declare
List : Aggregated_Project_List :=
Project.Aggregated_Projects;
List : Aggregated_Project_List := Project.Aggregated_Projects;
begin
-- Look for a non aggregate project until one is found
@ -1664,6 +1663,8 @@ package body Prj.Conf is
end if;
end Check_Project;
-- Start of processing for Process_Project_And_Apply_Config
begin
Main_Project := No_Project;
Automatically_Generated := False;

2
gcc/ada/s-os_lib.adb
View file

@ -1656,7 +1656,7 @@ package body System.OS_Lib is
procedure Normalize_Arguments (Args : in out Argument_List) is
procedure Quote_Argument (Arg : in out String_Access);
-- Add quote around argument if it contains spaces
-- Add quote around argument if it contains spaces (or HT characters)
C_Argument_Needs_Quote : Integer;
pragma Import (C, C_Argument_Needs_Quote, "__gnat_argument_needs_quote");

18
gcc/ada/sem_ch12.adb
View file

@ -10452,24 +10452,24 @@ package body Sem_Ch12 is
T : constant Entity_Id := Get_Instance_Of (Gen_T);
begin
-- Some detailed comments would be useful here ???
return ((Base_Type (T) = Act_T
or else Base_Type (T) = Base_Type (Act_T))
and then Subtypes_Statically_Match (T, Act_T))
or else (Is_Class_Wide_Type (Gen_T)
and then Is_Class_Wide_Type (Act_T)
and then
Subtypes_Match
(Get_Instance_Of (Root_Type (Gen_T)),
Root_Type (Act_T)))
and then Subtypes_Match
(Get_Instance_Of (Root_Type (Gen_T)),
Root_Type (Act_T)))
or else
((Ekind (Gen_T) = E_Anonymous_Access_Subprogram_Type
or else Ekind (Gen_T) = E_Anonymous_Access_Type)
(Ekind_In (Gen_T, E_Anonymous_Access_Subprogram_Type,
E_Anonymous_Access_Type)
and then Ekind (Act_T) = Ekind (Gen_T)
and then
Subtypes_Statically_Match
(Designated_Type (Gen_T), Designated_Type (Act_T)));
and then Subtypes_Statically_Match
(Designated_Type (Gen_T), Designated_Type (Act_T)));
end Subtypes_Match;
-----------------------------------------

29
gcc/ada/sem_ch8.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- --
@ -2804,16 +2804,23 @@ package body Sem_Ch8 is
end if;
end if;
if not Is_Actual
and then (Old_S = New_S
or else
(Nkind (Nam) /= N_Expanded_Name
and then Chars (Old_S) = Chars (New_S))
or else
(Nkind (Nam) = N_Expanded_Name
and then Entity (Prefix (Nam)) = Current_Scope
and then
Chars (Selector_Name (Nam)) = Chars (New_S)))
if Is_Actual then
null;
-- The following is illegal, because F hides whatever other F may
-- be around:
-- function F (..) renames F;
elsif Old_S = New_S
or else (Nkind (Nam) /= N_Expanded_Name
and then Chars (Old_S) = Chars (New_S))
then
Error_Msg_N ("subprogram cannot rename itself", N);
elsif Nkind (Nam) = N_Expanded_Name
and then Entity (Prefix (Nam)) = Current_Scope
and then Chars (Selector_Name (Nam)) = Chars (New_S)
and then not Rational_Profile
then
Error_Msg_N ("subprogram cannot rename itself", N);
end if;

15
gcc/ada/sem_prag.adb
View file

@ -13859,7 +13859,7 @@ package body Sem_Prag is
-- pragma Profile (profile_IDENTIFIER);
-- profile_IDENTIFIER => Restricted | Ravenscar
-- profile_IDENTIFIER => Restricted | Ravenscar | Rational
when Pragma_Profile =>
Ada_2005_Pragma;
@ -13879,6 +13879,9 @@ package body Sem_Prag is
(Restricted,
N, Warn => Treat_Restrictions_As_Warnings);
elsif Chars (Argx) = Name_Rational then
Rational_Profile := True;
elsif Chars (Argx) = Name_No_Implementation_Extensions then
Set_Profile_Restrictions
(No_Implementation_Extensions,
@ -14275,6 +14278,15 @@ package body Sem_Prag is
end if;
end;
--------------
-- Rational --
--------------
-- pragma Rational, for compatibility with foreign compiler
when Pragma_Rational =>
Rational_Profile := True;
-----------------------
-- Relative_Deadline --
-----------------------
@ -16599,6 +16611,7 @@ package body Sem_Prag is
Pragma_Pure_12 => -1,
Pragma_Pure_Function => -1,
Pragma_Queuing_Policy => -1,
Pragma_Rational => -1,
Pragma_Ravenscar => -1,
Pragma_Relative_Deadline => -1,
Pragma_Remote_Access_Type => -1,

11
gcc/ada/sem_res.adb
View file

@ -3423,7 +3423,9 @@ package body Sem_Res is
-- * For a scalar type that has the Default_Value aspect
-- specified, the formal parameter is initialized from the
-- value of the actual, without checking that the value
-- satisfies any constraint or any predicate;
-- satisfies any constraint or any predicate.
-- I do not understand why this case is included??? this is
-- not a case where an OUT parameter is treated as IN OUT.
-- * For a composite type with discriminants or that has
-- implicit initial values for any subcomponents, the
@ -3442,10 +3444,9 @@ package body Sem_Res is
Present (Default_Aspect_Value (Etype (F))))
or else
(Is_Composite_Type (Etype (F))
and then
(Has_Discriminants (Etype (F))
or else
Is_Partially_Initialized_Type (Etype (F)))))
and then (Has_Discriminants (Etype (F))
or else Is_Partially_Initialized_Type
(Etype (F)))))
then
Generate_Reference (Orig_A, A);
end if;

4
gcc/ada/snames.ads-tmpl
View file

@ -6,7 +6,7 @@
-- --
-- T e m p l a t e --
-- --
-- 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- --
@ -422,6 +422,7 @@ package Snames is
Name_Profile_Warnings : constant Name_Id := N + $; -- GNAT
Name_Propagate_Exceptions : constant Name_Id := N + $; -- GNAT
Name_Queuing_Policy : constant Name_Id := N + $;
Name_Rational : constant Name_Id := N + $; -- GNAT
Name_Ravenscar : constant Name_Id := N + $; -- GNAT
Name_Restricted_Run_Time : constant Name_Id := N + $; -- GNAT
Name_Restrictions : constant Name_Id := N + $;
@ -1717,6 +1718,7 @@ package Snames is
Pragma_Profile_Warnings,
Pragma_Propagate_Exceptions,
Pragma_Queuing_Policy,
Pragma_Rational,
Pragma_Ravenscar,
Pragma_Restricted_Run_Time,
Pragma_Restrictions,

1
gcc/ada/ug_words
View file

@ -74,6 +74,7 @@ gcc -c ^ GNAT COMPILE
-gnateS ^ /SCO_OUTPUT
-gnatet ^ /TARGET_DEPENDENT_INFO
-gnateV ^ /PARAMETER_VALIDITY_CHECK
-gnateY ^ /IGNORE_STYLE_CHECKS_PRAGMAS
-gnatE ^ /CHECKS=ELABORATION
-gnatf ^ /REPORT_ERRORS=FULL
-gnatF ^ /UPPERCASE_EXTERNALS