aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--gcc/ada/ChangeLog27
-rw-r--r--gcc/ada/checks.adb12
-rw-r--r--gcc/ada/exp_ch5.adb3
-rw-r--r--gcc/ada/exp_util.adb6
-rw-r--r--gcc/ada/opt.ads4
-rw-r--r--gcc/ada/par-prag.adb3
-rw-r--r--gcc/ada/prj-conf.adb13
-rw-r--r--gcc/ada/s-os_lib.adb2
-rw-r--r--gcc/ada/sem_ch12.adb18
-rw-r--r--gcc/ada/sem_ch8.adb29
-rw-r--r--gcc/ada/sem_prag.adb15
-rw-r--r--gcc/ada/sem_res.adb11
-rw-r--r--gcc/ada/snames.ads-tmpl4
-rw-r--r--gcc/ada/ug_words1
14 files changed, 103 insertions, 45 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 31af157..12c6dc5 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -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
diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index 37c6dd1..7afabd1 100644
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -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
diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb
index 66a7959..243279b 100644
--- a/gcc/ada/exp_ch5.adb
+++ b/gcc/ada/exp_ch5.adb
@@ -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
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 3528fc9..1900a9f 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -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
diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads
index e2a97e2..8d79222 100644
--- a/gcc/ada/opt.ads
+++ b/gcc/ada/opt.ads
@@ -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
diff --git a/gcc/ada/par-prag.adb b/gcc/ada/par-prag.adb
index dd7b1d7..fdd5905 100644
--- a/gcc/ada/par-prag.adb
+++ b/gcc/ada/par-prag.adb
@@ -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 |
diff --git a/gcc/ada/prj-conf.adb b/gcc/ada/prj-conf.adb
index c5f0381..9ba624c 100644
--- a/gcc/ada/prj-conf.adb
+++ b/gcc/ada/prj-conf.adb
@@ -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;
diff --git a/gcc/ada/s-os_lib.adb b/gcc/ada/s-os_lib.adb
index f893c8a..268e541 100644
--- a/gcc/ada/s-os_lib.adb
+++ b/gcc/ada/s-os_lib.adb
@@ -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");
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index 39ac6a9..3f8abe7 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -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;
-----------------------------------------
diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index a383795..ae7d97c 100644
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -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;
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 1bbd358..d72c7d7 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -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,
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 9dd2918..4fcbee9 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -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;
diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl
index e84cce2..4667195 100644
--- a/gcc/ada/snames.ads-tmpl
+++ b/gcc/ada/snames.ads-tmpl
@@ -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,
diff --git a/gcc/ada/ug_words b/gcc/ada/ug_words
index 10f03f5..77a36ca 100644
--- a/gcc/ada/ug_words
+++ b/gcc/ada/ug_words
@@ -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
generated by cgit v1.1 at 2025-03-12 15:04:30 +0000