summaryrefslogtreecommitdiff
path: root/gcc/ada
diff options
context:
space:
mode:
authorArnaud Charlet <charlet@gcc.gnu.org>2013-02-06 11:44:33 +0100
committerArnaud Charlet <charlet@gcc.gnu.org>2013-02-06 11:44:33 +0100
commit9b7424a705ede81bcf45b214744872e54ffb9297 (patch)
treed5faf65f688ce9d431c15195adea371db53dcf30 /gcc/ada
parentd7761b2d64f02ce7b9fd7c354c2f5b98805235c6 (diff)
downloadgcc-9b7424a705ede81bcf45b214744872e54ffb9297.tar.gz
[multiple changes]
2013-02-06 Robert Dewar <dewar@adacore.com> * osint.ads: Minor fix of typo. 2013-02-06 Sergey Rybin <rybin@adacore.com frybin> * gnat_ugn.texi: gnatmetric: update the documentation of complexity metrics for Ada 2012. 2013-02-06 Javier Miranda <miranda@adacore.com> * exp_disp.adb (Make_Secondary_DT): Code cleanup: remove useless initialization. 2013-02-06 Ed Schonberg <schonberg@adacore.com> * sem_ch3.adb (Build_Discriminant_Constraints): Do not generate overflow checks on a discriminant expression if the discriminant constraint is applied to a private type that has a full view, because the check will be applied when the full view is elaborated. Removing the redundant check is not just an optimization, but it prevents spurious assembler errors, because of the way the backend generates names for expressions that require overflow checking. 2013-02-06 Pascal Obry <obry@adacore.com> * s-osprim-mingw.adb: Removes workaround for an old GNU/Linker limitation on Windows. (DA): Removed. (LIA): Removed. (LLIA): Removed. (TFA): Removed. (BTA): Removed. (BMTA): Removed. (BCA): Removed. (BMCA): Removed. (BTiA): Removed. (Clock): Use variable corresponding to access. (Get_Base_Time): Likewise. (Monotonic_Clock): Likewise. 2013-02-06 Vincent Celier <celier@adacore.com> * make.adb (Gnatmake): When gnatmake is called with a project file, do not invoke gnatbind with -I-. * makeutl.adb (Create_Binder_Mapping_File): Rewrite function. Get the infos from all the sources. 2013-02-06 Ed Schonberg <schonberg@adacore.com> * snames.ads-tmpl: Add Name_Overriding_Renamings and pragma Overriding_Renamings. * par-prag.adb: Recognize pragma Overriding_Renamings. * opt.ads (Overriding_Renamings): flag to control compatibility mode with Rational compiler, replaces Rational_Profile flag. * sem_ch8.adb (Analyze_Subprogram_Renaming): When Overriding_Renamings is enabled, accept renaming declarations where the new subprogram renames and overrides a locally inherited operation. Improve error message for some illegal renamings. * sem_prag.adb (Analyze_Pragma): Add case for Overriding_Renamings. (Set_Rational_Profile): The Rational_Profile enables Overriding_Renamings, Implicit_Packing, and Use_Vads_Size. 2013-02-06 Ed Schonberg <schonberg@adacore.com> * sem_util.adb: Set parent of copied aggregate component, to prevent infinite loop. From-SVN: r195798
Diffstat (limited to 'gcc/ada')
-rw-r--r--gcc/ada/ChangeLog69
-rw-r--r--gcc/ada/exp_disp.adb16
-rw-r--r--gcc/ada/gnat_ugn.texi15
-rw-r--r--gcc/ada/make.adb3
-rw-r--r--gcc/ada/makeutl.adb202
-rw-r--r--gcc/ada/opt.ads5
-rw-r--r--gcc/ada/osint.ads2
-rw-r--r--gcc/ada/par-prag.adb1
-rw-r--r--gcc/ada/s-osprim-mingw.adb53
-rw-r--r--gcc/ada/sem_ch3.adb38
-rw-r--r--gcc/ada/sem_ch8.adb10
-rw-r--r--gcc/ada/sem_prag.adb26
-rw-r--r--gcc/ada/sem_util.adb1
-rw-r--r--gcc/ada/snames.ads-tmpl2
14 files changed, 282 insertions, 161 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index d41a8d1300f..8f99e15ce98 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,74 @@
2013-02-06 Robert Dewar <dewar@adacore.com>
+ * osint.ads: Minor fix of typo.
+
+2013-02-06 Sergey Rybin <rybin@adacore.com frybin>
+
+ * gnat_ugn.texi: gnatmetric: update the documentation of
+ complexity metrics for Ada 2012.
+
+2013-02-06 Javier Miranda <miranda@adacore.com>
+
+ * exp_disp.adb (Make_Secondary_DT): Code cleanup:
+ remove useless initialization.
+
+2013-02-06 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch3.adb (Build_Discriminant_Constraints): Do not
+ generate overflow checks on a discriminant expression if the
+ discriminant constraint is applied to a private type that has
+ a full view, because the check will be applied when the full
+ view is elaborated. Removing the redundant check is not just
+ an optimization, but it prevents spurious assembler errors,
+ because of the way the backend generates names for expressions
+ that require overflow checking.
+
+2013-02-06 Pascal Obry <obry@adacore.com>
+
+ * s-osprim-mingw.adb: Removes workaround for an old GNU/Linker
+ limitation on Windows.
+ (DA): Removed.
+ (LIA): Removed.
+ (LLIA): Removed.
+ (TFA): Removed.
+ (BTA): Removed.
+ (BMTA): Removed.
+ (BCA): Removed.
+ (BMCA): Removed.
+ (BTiA): Removed.
+ (Clock): Use variable corresponding to access.
+ (Get_Base_Time): Likewise.
+ (Monotonic_Clock): Likewise.
+
+2013-02-06 Vincent Celier <celier@adacore.com>
+
+ * make.adb (Gnatmake): When gnatmake is called with a project
+ file, do not invoke gnatbind with -I-.
+ * makeutl.adb (Create_Binder_Mapping_File): Rewrite function. Get
+ the infos from all the sources.
+
+2013-02-06 Ed Schonberg <schonberg@adacore.com>
+
+ * snames.ads-tmpl: Add Name_Overriding_Renamings and pragma
+ Overriding_Renamings.
+ * par-prag.adb: Recognize pragma Overriding_Renamings.
+ * opt.ads (Overriding_Renamings): flag to control compatibility
+ mode with Rational compiler, replaces Rational_Profile flag.
+ * sem_ch8.adb (Analyze_Subprogram_Renaming): When
+ Overriding_Renamings is enabled, accept renaming declarations
+ where the new subprogram renames and overrides a locally inherited
+ operation. Improve error message for some illegal renamings.
+ * sem_prag.adb (Analyze_Pragma): Add case for Overriding_Renamings.
+ (Set_Rational_Profile): The Rational_Profile enables
+ Overriding_Renamings, Implicit_Packing, and Use_Vads_Size.
+
+2013-02-06 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_util.adb: Set parent of copied aggregate component, to
+ prevent infinite loop.
+
+2013-02-06 Robert Dewar <dewar@adacore.com>
+
* sem_ch3.adb, sem_ch10.adb: Minor reformatting.
* exp_disp.adb: Minor comment update.
* comperr.ads, osint.ads, rtsfind.adb, sem_prag.adb: Minor addition of
diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb
index bc4ab5099f5..bf530cb4769 100644
--- a/gcc/ada/exp_disp.adb
+++ b/gcc/ada/exp_disp.adb
@@ -4129,20 +4129,10 @@ package body Exp_Disp is
DT_Constr_List := New_List;
DT_Aggr_List := New_List;
- -- Nb_Prim. If the tagged type has no primitives we add a dummy
- -- slot whose address will be the tag of this type.
-
- -- ???codepeer???
- -- Nb_Prim cannot be zero here, so this test is wrong
+ -- Nb_Prim
- if Nb_Prim = 0 then
- New_Node := Make_Integer_Literal (Loc, 1);
- else
- New_Node := Make_Integer_Literal (Loc, Nb_Prim);
- end if;
-
- Append_To (DT_Constr_List, New_Node);
- Append_To (DT_Aggr_List, New_Copy (New_Node));
+ Append_To (DT_Constr_List, Make_Integer_Literal (Loc, Nb_Prim));
+ Append_To (DT_Aggr_List, Make_Integer_Literal (Loc, Nb_Prim));
-- Signature
diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index 17478c0b263..f36faff4701 100644
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -7,7 +7,7 @@
@c o
@c G N A T _ U G N o
@c o
-@c Copyright (C) 1992-2012, Free Software Foundation, Inc. o
+@c Copyright (C) 1992-2013, Free Software Foundation, Inc. o
@c o
@c oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
@@ -14916,8 +14916,9 @@ The McCabe cyclomatic complexity metric is defined
in @url{http://www.mccabe.com/pdf/mccabe-nist235r.pdf}
According to McCabe, both control statements and short-circuit control forms
-should be taken into account when computing cyclomatic complexity. For each
-body, we compute three metric values:
+should be taken into account when computing cyclomatic complexity.
+For Ada 2012 we have also take into account conditional expressions
+and quantified expressions. For each body, we compute three metric values:
@itemize @bullet
@item
@@ -14934,6 +14935,10 @@ cyclomatic complexity, which is the sum of these two values.
@noindent
+The cyclomatic complexity is also computed for Ada 2012 expression functions.
+An expression function cannot have statements as its components, so only one
+metric value is computed as a cyclomatic complexity of an expression function.
+
The origin of cyclomatic complexity metric is the need to estimate the number
of independent paths in the control flow graph that in turn gives the number
of tests needed to satisfy paths coverage testing completeness criterion.
@@ -14962,7 +14967,9 @@ suitable for typical Ada usage. For example, short circuit forms
are not penalized as unstructured in the Ada essential complexity metric.
When computing cyclomatic and essential complexity, @command{gnatmetric} skips
-the code in the exception handlers and in all the nested program units.
+the code in the exception handlers and in all the nested program units. The
+code of assertions and predicates (that is, subprogram preconditions and
+postconditions, subtype predicates and type invariants) is also skipped.
By default, all the complexity metrics are computed and reported.
For more fine-grained control you can use
diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb
index 61649da3bb8..27d0f697e98 100644
--- a/gcc/ada/make.adb
+++ b/gcc/ada/make.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- --
@@ -5895,7 +5895,6 @@ package body Make is
-- projects.
Look_In_Primary_Dir := False;
- Add_Switch ("-I-", Binder, And_Save => True);
end if;
-- If the user wants a program without a main subprogram, add the
diff --git a/gcc/ada/makeutl.adb b/gcc/ada/makeutl.adb
index b2a6d53bb48..6d33aaacca7 100644
--- a/gcc/ada/makeutl.adb
+++ b/gcc/ada/makeutl.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 2004-2012, Free Software Foundation, Inc. --
+-- Copyright (C) 2004-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- --
@@ -369,6 +369,14 @@ package body Makeutl is
Status : Boolean;
-- For call to Close
+ Iter : Source_Iterator :=
+ For_Each_Source
+ (In_Tree => Project_Tree,
+ Language => Name_Ada,
+ Encapsulated_Libs => False,
+ Locally_Removed => False);
+ Source : Prj.Source_Id;
+
begin
Tempdir.Create_Temp_File (Mapping_FD, Mapping_Path);
Record_Temp_File (Project_Tree.Shared, Mapping_Path);
@@ -376,57 +384,62 @@ package body Makeutl is
if Mapping_FD /= Invalid_FD then
OK := True;
- -- Traverse all units
+ loop
+ Source := Element (Iter);
+ exit when Source = No_Source;
- Unit := Units_Htable.Get_First (Project_Tree.Units_HT);
- while Unit /= No_Unit_Index loop
- if Unit.Name /= No_Name then
+ Unit := Source.Unit;
- -- If there is a body, put it in the mapping
+ if Unit = No_Unit_Index or else Unit.Name = No_Name then
+ ALI_Name := No_File;
- if Unit.File_Names (Impl) /= No_Source
- and then Unit.File_Names (Impl).Project /= No_Project
- then
- Get_Name_String (Unit.Name);
- Add_Str_To_Name_Buffer ("%b");
- ALI_Unit := Name_Find;
- ALI_Name :=
- Lib_File_Name (Unit.File_Names (Impl).Display_File);
- ALI_Project := Unit.File_Names (Impl).Project;
+ -- If this is a body, put it in the mapping
- -- Otherwise, if there is a spec, put it in the mapping
-
- elsif Unit.File_Names (Spec) /= No_Source
- and then Unit.File_Names (Spec).Project /= No_Project
- then
- Get_Name_String (Unit.Name);
- Add_Str_To_Name_Buffer ("%s");
- ALI_Unit := Name_Find;
- ALI_Name :=
- Lib_File_Name (Unit.File_Names (Spec).Display_File);
- ALI_Project := Unit.File_Names (Spec).Project;
+ elsif Source.Kind = Impl
+ and then Unit.File_Names (Impl) /= No_Source
+ and then Unit.File_Names (Impl).Project /= No_Project
+ then
+ Get_Name_String (Unit.Name);
+ Add_Str_To_Name_Buffer ("%b");
+ ALI_Unit := Name_Find;
+ ALI_Name :=
+ Lib_File_Name (Unit.File_Names (Impl).Display_File);
+ ALI_Project := Unit.File_Names (Impl).Project;
+
+ -- Otherwise, if this is a spec and there is no body, put it in
+ -- the mapping.
+
+ elsif Source.Kind = Spec
+ and then Unit.File_Names (Impl) = No_Source
+ and then Unit.File_Names (Spec) /= No_Source
+ and then Unit.File_Names (Spec).Project /= No_Project
+ then
+ Get_Name_String (Unit.Name);
+ Add_Str_To_Name_Buffer ("%s");
+ ALI_Unit := Name_Find;
+ ALI_Name :=
+ Lib_File_Name (Unit.File_Names (Spec).Display_File);
+ ALI_Project := Unit.File_Names (Spec).Project;
- else
- ALI_Name := No_File;
- end if;
+ else
+ ALI_Name := No_File;
+ end if;
- -- If we have something to put in the mapping then do it now.
- -- However, if the project is extended, we don't put anything
- -- in the mapping file, since we don't know where the ALI file
- -- is: it might be in the extended project object directory as
- -- well as in the extending project object directory.
+ -- If we have something to put in the mapping then do it now. If
+ -- the project is extended, look for the ALI file in the project,
+ -- then in the extending projects in order, and use the last one
+ -- found.
- if ALI_Name /= No_File
- and then ALI_Project.Extended_By = No_Project
- and then ALI_Project.Extends = No_Project
- then
- -- First check if the ALI file exists. If it does not, do
- -- not put the unit in the mapping file.
+ if ALI_Name /= No_File then
+ -- Look in the project and the projects that are extending it
+ -- to find the real ALI file.
- declare
- ALI : constant String := Get_Name_String (ALI_Name);
+ declare
+ ALI : constant String := Get_Name_String (ALI_Name);
- begin
+ ALI_Path : Name_Id := No_Name;
+ begin
+ loop
-- For library projects, use the library ALI directory,
-- for other projects, use the object directory.
@@ -439,63 +452,62 @@ package body Makeutl is
end if;
Add_Str_To_Name_Buffer (ALI);
+
+ if Is_Regular_File (Name_Buffer (1 .. Name_Len)) then
+ ALI_Path := Name_Find;
+ end if;
+
+ ALI_Project := ALI_Project.Extended_By;
+ exit when ALI_Project = No_Project;
+ end loop;
+
+ if ALI_Path /= No_Name then
+ -- First line is the unit name
+
+ Get_Name_String (ALI_Unit);
Add_Char_To_Name_Buffer (ASCII.LF);
+ Bytes :=
+ Write
+ (Mapping_FD,
+ Name_Buffer (1)'Address,
+ Name_Len);
+ OK := Bytes = Name_Len;
- declare
- ALI_Path_Name : constant String :=
- Name_Buffer (1 .. Name_Len);
+ exit when not OK;
- begin
- if Is_Regular_File
- (ALI_Path_Name (1 .. ALI_Path_Name'Last - 1))
- then
- -- First line is the unit name
-
- Get_Name_String (ALI_Unit);
- Add_Char_To_Name_Buffer (ASCII.LF);
- Bytes :=
- Write
- (Mapping_FD,
- Name_Buffer (1)'Address,
- Name_Len);
- OK := Bytes = Name_Len;
-
- exit when not OK;
-
- -- Second line it the ALI file name
-
- Get_Name_String (ALI_Name);
- Add_Char_To_Name_Buffer (ASCII.LF);
- Bytes :=
- Write
- (Mapping_FD,
- Name_Buffer (1)'Address,
- Name_Len);
- OK := (Bytes = Name_Len);
-
- exit when not OK;
-
- -- Third line it the ALI path name
-
- Bytes :=
- Write
- (Mapping_FD,
- ALI_Path_Name (1)'Address,
- ALI_Path_Name'Length);
- OK := (Bytes = ALI_Path_Name'Length);
-
- -- If OK is False, it means we were unable to
- -- write a line. No point in continuing with the
- -- other units.
-
- exit when not OK;
- end if;
- end;
- end;
- end if;
+ -- Second line it the ALI file name
+
+ Get_Name_String (ALI_Name);
+ Add_Char_To_Name_Buffer (ASCII.LF);
+ Bytes :=
+ Write
+ (Mapping_FD,
+ Name_Buffer (1)'Address,
+ Name_Len);
+ OK := (Bytes = Name_Len);
+
+ exit when not OK;
+
+ -- Third line it the ALI path name
+
+ Get_Name_String (ALI_Path);
+ Add_Char_To_Name_Buffer (ASCII.LF);
+ Bytes :=
+ Write
+ (Mapping_FD,
+ Name_Buffer (1)'Address,
+ Name_Len);
+ OK := (Bytes = Name_Len);
+
+ -- If OK is False, it means we were unable to write a
+ -- line. No point in continuing with the other units.
+
+ exit when not OK;
+ end if;
+ end;
end if;
- Unit := Units_Htable.Get_Next (Project_Tree.Units_HT);
+ Next (Iter);
end loop;
Close (Mapping_FD, Status);
diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads
index 8d792224b2a..9beeb583523 100644
--- a/gcc/ada/opt.ads
+++ b/gcc/ada/opt.ads
@@ -1181,9 +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;
+ Overriding_Renamings : Boolean := False;
-- GNAT
- -- Set to True to enable compatibility mode with Rational compiler.
+ -- Set to True to enable compatibility mode with Rational compiler, and
+ -- to accept renamings of implicit operations in their own scope.
Replace_In_Comments : Boolean := False;
-- GNATPREP
diff --git a/gcc/ada/osint.ads b/gcc/ada/osint.ads
index cbbcd92a193..dba06aad1c4 100644
--- a/gcc/ada/osint.ads
+++ b/gcc/ada/osint.ads
@@ -637,7 +637,7 @@ package Osint is
-- Set_Exit_Status as the last action of the program.
procedure OS_Exit_Through_Exception (Status : Integer);
- pragma No_Return;
+ pragma No_Return (OS_Exit_Through_Exception);
-- Set the Current_Exit_Status, then raise Types.Terminate_Program
type Exit_Code_Type is (
diff --git a/gcc/ada/par-prag.adb b/gcc/ada/par-prag.adb
index fdd5905cd93..4e02bfb7030 100644
--- a/gcc/ada/par-prag.adb
+++ b/gcc/ada/par-prag.adb
@@ -1218,6 +1218,7 @@ begin
Pragma_Optimize |
Pragma_Optimize_Alignment |
Pragma_Overflow_Mode |
+ Pragma_Overriding_Renamings |
Pragma_Pack |
Pragma_Partition_Elaboration_Policy |
Pragma_Passive |
diff --git a/gcc/ada/s-osprim-mingw.adb b/gcc/ada/s-osprim-mingw.adb
index 931d0127623..34d3e344da4 100644
--- a/gcc/ada/s-osprim-mingw.adb
+++ b/gcc/ada/s-osprim-mingw.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1998-2012, Free Software Foundation, Inc. --
+-- Copyright (C) 1998-2013, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
@@ -42,46 +42,23 @@ package body System.OS_Primitives is
-- Data for the high resolution clock --
----------------------------------------
- -- Declare some pointers to access multi-word data above. This is needed
- -- to workaround a limitation in the GNU/Linker auto-import feature used
- -- to build the GNAT runtime DLLs. In fact the Clock and Monotonic_Clock
- -- routines are inlined and they are using some multi-word variables.
- -- GNU/Linker will fail to auto-import those variables when building
- -- libgnarl.dll. The indirection level introduced here has no measurable
- -- penalties.
-
- type DA is access all Duration;
- -- Use to have indirect access to multi-word variables
-
- type LIA is access all LARGE_INTEGER;
- -- Use to have indirect access to multi-word variables
-
- type LLIA is access all Long_Long_Integer;
- -- Use to have indirect access to multi-word variables
-
Tick_Frequency : aliased LARGE_INTEGER;
- TFA : constant LIA := Tick_Frequency'Access;
-- Holds frequency of high-performance counter used by Clock
-- Windows NT uses a 1_193_182 Hz counter on PCs.
- Base_Ticks : aliased LARGE_INTEGER;
- BTA : constant LIA := Base_Ticks'Access;
+ Base_Ticks : LARGE_INTEGER;
-- Holds the Tick count for the base time
- Base_Monotonic_Ticks : aliased LARGE_INTEGER;
- BMTA : constant LIA := Base_Monotonic_Ticks'Access;
+ Base_Monotonic_Ticks : LARGE_INTEGER;
-- Holds the Tick count for the base monotonic time
- Base_Clock : aliased Duration;
- BCA : constant DA := Base_Clock'Access;
+ Base_Clock : Duration;
-- Holds the current clock for the standard clock's base time
- Base_Monotonic_Clock : aliased Duration;
- BMCA : constant DA := Base_Monotonic_Clock'Access;
+ Base_Monotonic_Clock : Duration;
-- Holds the current clock for monotonic clock's base time
- Base_Time : aliased Long_Long_Integer;
- BTiA : constant LLIA := Base_Time'Access;
+ Base_Time : Long_Long_Integer;
-- Holds the base time used to check for system time change, used with
-- the standard clock.
@@ -118,12 +95,12 @@ package body System.OS_Primitives is
GetSystemTimeAsFileTime (Now'Access);
Elap_Secs_Sys :=
- Duration (Long_Long_Float (abs (Now - BTiA.all)) /
+ Duration (Long_Long_Float (abs (Now - Base_Time)) /
Hundreds_Nano_In_Sec);
Elap_Secs_Tick :=
- Duration (Long_Long_Float (Current_Ticks - BTA.all) /
- Long_Long_Float (TFA.all));
+ Duration (Long_Long_Float (Current_Ticks - Base_Ticks) /
+ Long_Long_Float (Tick_Frequency));
-- If we have a shift of more than Max_Shift seconds we resynchronize
-- the Clock. This is probably due to a manual Clock adjustment, a DST
@@ -134,11 +111,11 @@ package body System.OS_Primitives is
Get_Base_Time;
Elap_Secs_Tick :=
- Duration (Long_Long_Float (Current_Ticks - BTA.all) /
- Long_Long_Float (TFA.all));
+ Duration (Long_Long_Float (Current_Ticks - Base_Ticks) /
+ Long_Long_Float (Tick_Frequency));
end if;
- return BCA.all + Elap_Secs_Tick;
+ return Base_Clock + Elap_Secs_Tick;
end Clock;
-------------------
@@ -243,9 +220,9 @@ package body System.OS_Primitives is
else
Elap_Secs_Tick :=
- Duration (Long_Long_Float (Current_Ticks - BMTA.all) /
- Long_Long_Float (TFA.all));
- return BMCA.all + Elap_Secs_Tick;
+ Duration (Long_Long_Float (Current_Ticks - Base_Monotonic_Ticks) /
+ Long_Long_Float (Tick_Frequency));
+ return Base_Monotonic_Clock + Elap_Secs_Tick;
end if;
end Monotonic_Clock;
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 130cba6de62..2346b10a1d0 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -8295,6 +8295,15 @@ package body Sem_Ch3 is
-- Return the Position number within array Discr_Expr of a discriminant
-- D within the discriminant list of the discriminated type T.
+ procedure Process_Discriminant_Expression
+ (Expr : Node_Id;
+ D : Entity_Id);
+ -- If this is a discriminant constraint on a partial view, do not
+ -- generate an overflow check on the discriminant expression. The check
+ -- will be generated when constraining the full view. Otherwise the
+ -- backend creates duplicate symbols for the temporaries corresponding
+ -- to the expressions to be checked, causing spurious assembler errors.
+
------------------
-- Pos_Of_Discr --
------------------
@@ -8319,6 +8328,31 @@ package body Sem_Ch3 is
raise Program_Error;
end Pos_Of_Discr;
+ -------------------------------------
+ -- Process_Discriminant_Expression --
+ -------------------------------------
+
+ procedure Process_Discriminant_Expression
+ (Expr : Node_Id;
+ D : Entity_Id)
+ is
+ BDT : constant Entity_Id := Base_Type (Etype (D));
+
+ begin
+ -- If this is a discriminant constraint on a partial view, do
+ -- not generate an overflow on the discriminant expression. The
+ -- check will be generated when constraining the full view.
+
+ if Is_Private_Type (T)
+ and then Present (Full_View (T))
+ then
+ Analyze_And_Resolve (Expr, BDT, Suppress => Overflow_Check);
+
+ else
+ Analyze_And_Resolve (Expr, BDT);
+ end if;
+ end Process_Discriminant_Expression;
+
-- Declarations local to Build_Discriminant_Constraints
Discr : Entity_Id;
@@ -8359,7 +8393,7 @@ package body Sem_Ch3 is
Discr_Expr (D) := Error;
else
- Analyze_And_Resolve (Constr, Base_Type (Etype (Discr)));
+ Process_Discriminant_Expression (Constr, Discr);
Discr_Expr (D) := Constr;
end if;
@@ -8470,7 +8504,7 @@ package body Sem_Ch3 is
end if;
Discr_Expr (Position) := Expr;
- Analyze_And_Resolve (Expr, Base_Type (Etype (Discr)));
+ Process_Discriminant_Expression (Expr, Discr);
end if;
-- A discriminant association with more than one discriminant
diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index ae7d97c8fb3..32d49cc6932 100644
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -2820,9 +2820,15 @@ package body Sem_Ch8 is
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);
+ if Overriding_Renamings then
+ null;
+
+ else
+ Error_Msg_NE
+ ("implicit operation& is not visible (RM 8.3 (15))",
+ Nam, Old_S);
+ end if;
end if;
Set_Convention (New_S, Convention (Old_S));
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 1a34b3423f5..70916cdc5db 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -947,6 +947,10 @@ package body Sem_Prag is
-- argument has the right form then the Mechanism field of Ent is
-- set appropriately.
+ procedure Set_Rational_Profile;
+ -- Activate the set of configuration pragmas and permissions that make
+ -- up the Rational profile.
+
procedure Set_Ravenscar_Profile (N : Node_Id);
-- Activate the set of configuration pragmas and restrictions that make
-- up the Ravenscar Profile. N is the corresponding pragma node, which
@@ -6362,6 +6366,20 @@ package body Sem_Prag is
end if;
end Set_Mechanism_Value;
+ --------------------------
+ -- Set_Rational_Profile --
+ --------------------------
+
+ -- The Rational profile includes Implicit_Packing, Use_Vads_Size, and
+ -- and extension to the semantics of renaming declarations.
+
+ procedure Set_Rational_Profile is
+ begin
+ Implicit_Packing := True;
+ Overriding_Renamings := True;
+ Use_VADS_Size := True;
+ end Set_Rational_Profile;
+
---------------------------
-- Set_Ravenscar_Profile --
---------------------------
@@ -13063,6 +13081,9 @@ package body Sem_Prag is
end if;
end Overflow_Mode;
+ when Pragma_Overriding_Renamings =>
+ Overriding_Renamings := True;
+
-------------
-- Ordered --
-------------
@@ -13884,7 +13905,7 @@ package body Sem_Prag is
N, Warn => Treat_Restrictions_As_Warnings);
elsif Chars (Argx) = Name_Rational then
- Rational_Profile := True;
+ Set_Rational_Profile;
elsif Chars (Argx) = Name_No_Implementation_Extensions then
Set_Profile_Restrictions
@@ -14289,7 +14310,7 @@ package body Sem_Prag is
-- pragma Rational, for compatibility with foreign compiler
when Pragma_Rational =>
- Rational_Profile := True;
+ Set_Rational_Profile;
-----------------------
-- Relative_Deadline --
@@ -16591,6 +16612,7 @@ package body Sem_Prag is
Pragma_Optimize => -1,
Pragma_Optimize_Alignment => -1,
Pragma_Overflow_Mode => 0,
+ Pragma_Overriding_Renamings => 0,
Pragma_Ordered => 0,
Pragma_Pack => 0,
Pragma_Page => -1,
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index aa585605843..74a701770ac 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -1746,6 +1746,7 @@ package body Sem_Util is
if not Analyzed (Expression (Assoc)) then
Comp_Expr :=
New_Copy_Tree (Expression (Assoc));
+ Set_Parent (Comp_Expr, Parent (N));
Preanalyze_Without_Errors (Comp_Expr);
else
Comp_Expr := Expression (Assoc);
diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl
index 466719542e6..55c6329920d 100644
--- a/gcc/ada/snames.ads-tmpl
+++ b/gcc/ada/snames.ads-tmpl
@@ -414,6 +414,7 @@ package Snames is
Name_Normalize_Scalars : constant Name_Id := N + $;
Name_Optimize_Alignment : constant Name_Id := N + $; -- GNAT
Name_Overflow_Mode : constant Name_Id := N + $; -- GNAT
+ Name_Overriding_Renamings : constant Name_Id := N + $; -- GNAT
Name_Partition_Elaboration_Policy : constant Name_Id := N + $; -- Ada 05
Name_Persistent_BSS : constant Name_Id := N + $; -- GNAT
Name_Polling : constant Name_Id := N + $; -- GNAT
@@ -1710,6 +1711,7 @@ package Snames is
Pragma_Normalize_Scalars,
Pragma_Optimize_Alignment,
Pragma_Overflow_Mode,
+ Pragma_Overriding_Renamings,
Pragma_Partition_Elaboration_Policy,
Pragma_Persistent_BSS,
Pragma_Polling,