From be3416c681291e5a3f6e68d311c958fb05bc7f41 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Tue, 25 Apr 2017 11:35:46 +0200 Subject: [PATCH] [multiple changes] 2017-04-25 Eric Botcazou * a-numaux.ads: Fix description of a-numaux-darwin and a-numaux-x86. (Double): Define to Long_Float. * a-numaux-vxworks.ads (Double): Likewise. * a-numaux-darwin.ads (Double): Likewise. * a-numaux-libc-x86.ads (Double): Define to Long_Long_Float. * a-numaux-x86.ads: Fix package description. * a-numaux-x86.adb (Is_Nan): Minor tweak. (Reduce): Adjust and complete description. Call Is_Nan instead of testing manually. Use an integer temporary to hold rounded value. * a-numaux-darwin.adb (Reduce): Likewise. (Is_Nan): New function. 2017-04-25 Ed Schonberg * sem_ch4.adb (Analyze_Selected_Component): Additional refinement on analysis of prefix whose type is a current instance of a synchronized type, but where the prefix itself is an entity that is an object. 2017-04-25 Ed Schonberg * exp_ch5.adb (Replace_Target): When rewriting the RHS, preserve the identity of callable entities therein, because they have been properly resolved, and prefixed calls may have been rewritten as normal calls. 2017-04-25 Patrick Bernardi * exp_ch3.adb (Build_Init_Statements): Convert the expression of the pragma/aspect Secondary_Stack_Size to internal type System.Parameters.Size_Type before assigning it to the Secondary_Stack_Size component of the task type's corresponding record. 2017-04-25 Eric Botcazou * sem_eval.adb (Compile_Time_Compare): Reinstate the expr+literal (etc) optimizations when the type is modular and the offsets are equal. 2017-04-25 Eric Botcazou * s-osinte-freebsd.ads: Minor comment tweaks 2017-04-25 Javier Miranda * urealp.adb (UR_Write): Reverse previous patch adding documentation on why we generate multiplications instead of divisions (needed to avoid expressions whose computation with large numbers may cause division by 0). 2017-04-25 Bob Duff * erroutc.adb (Set_Specific_Warning_Off, Set_Warnings_Mode_Off): Use the correct source file for Stop. Was using Current_Source_File, which is only valid during parsing. Current_Source_File will have a leftover value from whatever file happened to be parsed last, because of a with_clause or something. 2017-04-25 Bob Duff * lib.ads, lib.adb (In_Internal_Unit): New functions similar to In_Predefined_Unit, but including GNAT units. * sem_util.ads, sem_util.adb (Should_Ignore_Pragma): Replace with Should_Ignore_Pragma_Par and Should_Ignore_Pragma_Sem, because Should_Ignore_Pragma was not working reliably outside the parser, because Current_Source_File is not valid. * sem_prag.adb, exp_prag.adb: Call Should_Ignore_Pragma_Sem. * par-prag.adb: Call Should_Ignore_Pragma_Par. From-SVN: r247162 --- gcc/ada/ChangeLog | 75 +++++++++++++++++++++++++++++++++++ gcc/ada/a-numaux-darwin.adb | 48 +++++++++++++++++----- gcc/ada/a-numaux-darwin.ads | 4 +- gcc/ada/a-numaux-libc-x86.ads | 4 +- gcc/ada/a-numaux-vxworks.ads | 4 +- gcc/ada/a-numaux-x86.adb | 35 +++++++++------- gcc/ada/a-numaux-x86.ads | 5 ++- gcc/ada/a-numaux.ads | 9 +++-- gcc/ada/erroutc.adb | 4 +- gcc/ada/exp_aggr.adb | 2 +- gcc/ada/exp_ch3.adb | 5 +++ gcc/ada/exp_ch5.adb | 10 ++++- gcc/ada/exp_prag.adb | 2 +- gcc/ada/lib.adb | 16 ++++++++ gcc/ada/lib.ads | 5 +++ gcc/ada/par-prag.adb | 2 +- gcc/ada/s-osinte-freebsd.ads | 2 +- gcc/ada/sem_ch4.adb | 16 ++++++++ gcc/ada/sem_prag.adb | 2 +- gcc/ada/sem_util.adb | 30 +++++++++++--- gcc/ada/sem_util.ads | 6 ++- gcc/ada/sinfo.ads | 2 +- gcc/ada/urealp.adb | 19 +++++---- 23 files changed, 246 insertions(+), 61 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 87481487bc3..c3a8ba48598 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,78 @@ +2017-04-25 Eric Botcazou + + * a-numaux.ads: Fix description of a-numaux-darwin + and a-numaux-x86. + (Double): Define to Long_Float. + * a-numaux-vxworks.ads (Double): Likewise. + * a-numaux-darwin.ads + (Double): Likewise. + * a-numaux-libc-x86.ads (Double): Define to Long_Long_Float. + * a-numaux-x86.ads: Fix package description. + * a-numaux-x86.adb (Is_Nan): Minor tweak. + (Reduce): Adjust and complete description. Call Is_Nan instead of + testing manually. Use an integer temporary to hold rounded value. + * a-numaux-darwin.adb (Reduce): Likewise. + (Is_Nan): New function. + +2017-04-25 Ed Schonberg + + * sem_ch4.adb (Analyze_Selected_Component): Additional refinement + on analysis of prefix whose type is a current instance of a + synchronized type, but where the prefix itself is an entity that + is an object. + +2017-04-25 Ed Schonberg + + * exp_ch5.adb (Replace_Target): When rewriting the RHS, preserve + the identity of callable entities therein, because they have been + properly resolved, and prefixed calls may have been rewritten + as normal calls. + +2017-04-25 Patrick Bernardi + + * exp_ch3.adb (Build_Init_Statements): Convert + the expression of the pragma/aspect Secondary_Stack_Size to + internal type System.Parameters.Size_Type before assigning + it to the Secondary_Stack_Size component of the task type's + corresponding record. + +2017-04-25 Eric Botcazou + + * sem_eval.adb (Compile_Time_Compare): Reinstate the expr+literal + (etc) optimizations when the type is modular and the offsets + are equal. + +2017-04-25 Eric Botcazou + + * s-osinte-freebsd.ads: Minor comment tweaks + +2017-04-25 Javier Miranda + + * urealp.adb (UR_Write): Reverse previous patch + adding documentation on why we generate multiplications instead + of divisions (needed to avoid expressions whose computation with + large numbers may cause division by 0). + +2017-04-25 Bob Duff + + * erroutc.adb (Set_Specific_Warning_Off, + Set_Warnings_Mode_Off): Use the correct source file for + Stop. Was using Current_Source_File, which is only valid during + parsing. Current_Source_File will have a leftover value from + whatever file happened to be parsed last, because of a with_clause + or something. + +2017-04-25 Bob Duff + + * lib.ads, lib.adb (In_Internal_Unit): New functions similar + to In_Predefined_Unit, but including GNAT units. + * sem_util.ads, sem_util.adb (Should_Ignore_Pragma): Replace + with Should_Ignore_Pragma_Par and Should_Ignore_Pragma_Sem, + because Should_Ignore_Pragma was not working reliably outside + the parser, because Current_Source_File is not valid. + * sem_prag.adb, exp_prag.adb: Call Should_Ignore_Pragma_Sem. + * par-prag.adb: Call Should_Ignore_Pragma_Par. + 2017-04-25 Arnaud Charlet * gnat1drv.adb (Gnat1Drv): Disable Generate_Processed_File in diff --git a/gcc/ada/a-numaux-darwin.adb b/gcc/ada/a-numaux-darwin.adb index 2e9ffd91c11..3c4a1013036 100644 --- a/gcc/ada/a-numaux-darwin.adb +++ b/gcc/ada/a-numaux-darwin.adb @@ -7,7 +7,7 @@ -- B o d y -- -- (Apple OS X Version) -- -- -- --- Copyright (C) 1998-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 1998-2016, 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- -- @@ -36,11 +36,17 @@ package body Ada.Numerics.Aux is -- Local subprograms -- ----------------------- + function Is_Nan (X : Double) return Boolean; + -- Return True iff X is a IEEE NaN value + procedure Reduce (X : in out Double; Q : out Natural); - -- Implements reduction of X by Pi/2. Q is the quadrant of the final - -- result in the range 0 .. 3. The absolute value of X is at most Pi/4. + -- Implement reduction of X by Pi/2. Q is the quadrant of the final + -- result in the range 0..3. The absolute value of X is at most Pi/4. + -- It is needed to avoid a loss of accuracy for sin near Pi and cos + -- near Pi/2 due to the use of an insufficiently precise value of Pi + -- in the range reduction. - -- The following three functions implement Chebishev approximations + -- The following two functions implement Chebishev approximations -- of the trigonometric functions in their reduced domain. -- These approximations have been computed using Maple. @@ -51,6 +57,10 @@ package body Ada.Numerics.Aux is pragma Inline (Sine_Approx); pragma Inline (Cosine_Approx); + ------------------- + -- Cosine_Approx -- + ------------------- + function Cosine_Approx (X : Double) return Double is XX : constant Double := X * X; begin @@ -63,6 +73,10 @@ package body Ada.Numerics.Aux is - 16#3.655E64869ECCE#E-14 + 1.0; end Cosine_Approx; + ----------------- + -- Sine_Approx -- + ----------------- + function Sine_Approx (X : Double) return Double is XX : constant Double := X * X; begin @@ -74,6 +88,17 @@ package body Ada.Numerics.Aux is - 16#2.AAAAAAAAAAA44#E-01) * (XX * X) + X; end Sine_Approx; + ------------ + -- Is_Nan -- + ------------ + + function Is_Nan (X : Double) return Boolean is + begin + -- The IEEE NaN values are the only ones that do not equal themselves + + return X /= X; + end Is_Nan; + ------------ -- Reduce -- ------------ @@ -92,6 +117,7 @@ package body Ada.Numerics.Aux is - P4, HM); P6 : constant Double := Double'Model (Half_Pi - P1 - P2 - P3 - P4 - P5); K : Double; + R : Integer; begin -- For X < 2.0**HM, all products below are computed exactly. @@ -101,7 +127,7 @@ package body Ada.Numerics.Aux is -- rounded result of X - K * (Pi / 2.0). K := X * Two_Over_Pi; - while abs K >= 2.0 ** HM loop + while abs K >= 2.0**HM loop K := K * M - (K * M - K); X := (((((X - K * P1) - K * P2) - K * P3) - K * P4) - K * P5) - K * P6; @@ -110,14 +136,16 @@ package body Ada.Numerics.Aux is -- If K is not a number (because X was not finite) raise exception - if K /= K then + if Is_Nan (K) then raise Constraint_Error; end if; - K := Double'Rounding (K); - Q := Integer (K) mod 4; - X := (((((X - K * P1) - K * P2) - K * P3) - - K * P4) - K * P5) - K * P6; + -- Go through an integer temporary so as to use machine instructions + + R := Integer (Double'Rounding (K)); + Q := R mod 4; + K := Double (R); + X := (((((X - K * P1) - K * P2) - K * P3) - K * P4) - K * P5) - K * P6; end Reduce; --------- diff --git a/gcc/ada/a-numaux-darwin.ads b/gcc/ada/a-numaux-darwin.ads index 011ae592ce4..a548798826a 100644 --- a/gcc/ada/a-numaux-darwin.ads +++ b/gcc/ada/a-numaux-darwin.ads @@ -7,7 +7,7 @@ -- S p e c -- -- (Apple OS X Version) -- -- -- --- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2016, 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- -- @@ -39,7 +39,7 @@ package Ada.Numerics.Aux is pragma Linker_Options ("-lm"); - type Double is digits 15; + type Double is new Long_Float; -- Type Double is the type used to call the C routines -- The following functions have been implemented in Ada, since diff --git a/gcc/ada/a-numaux-libc-x86.ads b/gcc/ada/a-numaux-libc-x86.ads index 3b793c6240e..3f59fabdce6 100644 --- a/gcc/ada/a-numaux-libc-x86.ads +++ b/gcc/ada/a-numaux-libc-x86.ads @@ -7,7 +7,7 @@ -- S p e c -- -- (C Library Version for x86) -- -- -- --- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2016, 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- -- @@ -37,7 +37,7 @@ package Ada.Numerics.Aux is pragma Linker_Options ("-lm"); - type Double is digits 18; + type Double is new Long_Long_Float; -- We import these functions directly from C. Note that we label them -- all as pure functions, because indeed all of them are in fact pure. diff --git a/gcc/ada/a-numaux-vxworks.ads b/gcc/ada/a-numaux-vxworks.ads index 5fdf778b345..25fcd2d420e 100644 --- a/gcc/ada/a-numaux-vxworks.ads +++ b/gcc/ada/a-numaux-vxworks.ads @@ -7,7 +7,7 @@ -- S p e c -- -- (C Library Version, VxWorks) -- -- -- --- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2016, 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- -- @@ -36,7 +36,7 @@ package Ada.Numerics.Aux is pragma Pure; - type Double is digits 15; + type Double is new Long_Float; -- Type Double is the type used to call the C routines -- We import these functions directly from C. Note that we label them diff --git a/gcc/ada/a-numaux-x86.adb b/gcc/ada/a-numaux-x86.adb index 6f1f4624b60..b6690d13abe 100644 --- a/gcc/ada/a-numaux-x86.adb +++ b/gcc/ada/a-numaux-x86.adb @@ -49,8 +49,11 @@ package body Ada.Numerics.Aux is -- for values of Y in the open interval (-0.25, 0.25) procedure Reduce (X : in out Double; Q : out Natural); - -- Implements reduction of X by Pi/2. Q is the quadrant of the final - -- result in the range 0 .. 3. The absolute value of X is at most Pi. + -- Implement reduction of X by Pi/2. Q is the quadrant of the final + -- result in the range 0..3. The absolute value of X is at most Pi/4. + -- It is needed to avoid a loss of accuracy for sin near Pi and cos + -- near Pi/2 due to the use of an insufficiently precise value of Pi + -- in the range reduction. pragma Inline (Is_Nan); pragma Inline (Reduce); @@ -117,7 +120,7 @@ package body Ada.Numerics.Aux is begin -- The IEEE NaN values are the only ones that do not equal themselves - return not (X = X); + return X /= X; end Is_Nan; --------- @@ -154,32 +157,36 @@ package body Ada.Numerics.Aux is P5 : constant Double := Double'Leading_Part (Half_Pi - P1 - P2 - P3 - P4, HM); P6 : constant Double := Double'Model (Half_Pi - P1 - P2 - P3 - P4 - P5); - K : Double := X * Two_Over_Pi; + K : Double; + R : Integer; + begin - -- For X < 2.0**32, all products below are computed exactly. + -- For X < 2.0**HM, all products below are computed exactly. -- Due to cancellation effects all subtractions are exact as well. -- As no double extended floating-point number has more than 75 -- zeros after the binary point, the result will be the correctly -- rounded result of X - K * (Pi / 2.0). + K := X * Two_Over_Pi; while abs K >= 2.0**HM loop K := K * M - (K * M - K); - X := (((((X - K * P1) - K * P2) - K * P3) - - K * P4) - K * P5) - K * P6; + X := + (((((X - K * P1) - K * P2) - K * P3) - K * P4) - K * P5) - K * P6; K := X * Two_Over_Pi; end loop; - if K /= K then - - -- K is not a number, because X was not finite + -- If K is not a number (because X was not finite) raise exception + if Is_Nan (K) then raise Constraint_Error; end if; - K := Double'Rounding (K); - Q := Integer (K) mod 4; - X := (((((X - K * P1) - K * P2) - K * P3) - - K * P4) - K * P5) - K * P6; + -- Go through an integer temporary so as to use machine instructions + + R := Integer (Double'Rounding (K)); + Q := R mod 4; + K := Double (R); + X := (((((X - K * P1) - K * P2) - K * P3) - K * P4) - K * P5) - K * P6; end Reduce; ---------- diff --git a/gcc/ada/a-numaux-x86.ads b/gcc/ada/a-numaux-x86.ads index bf8b49c02ef..4c98ef1604a 100644 --- a/gcc/ada/a-numaux-x86.ads +++ b/gcc/ada/a-numaux-x86.ads @@ -7,7 +7,7 @@ -- S p e c -- -- (Machine Version for x86) -- -- -- --- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2016, 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- -- @@ -30,7 +30,8 @@ -- -- ------------------------------------------------------------------------------ --- Version for the x86, using 64-bit IEEE format with inline asm statements +-- This version is for the x86 using the 80-bit x86 long double format with +-- inline asm statements. package Ada.Numerics.Aux is pragma Pure; diff --git a/gcc/ada/a-numaux.ads b/gcc/ada/a-numaux.ads index f69fdc10da1..2e7d1e38dbf 100644 --- a/gcc/ada/a-numaux.ads +++ b/gcc/ada/a-numaux.ads @@ -7,7 +7,7 @@ -- S p e c -- -- (C Library Version, non-x86) -- -- -- --- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2016, 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- -- @@ -40,9 +40,10 @@ -- This version here is for use with normal Unix math functions. Alternative -- versions are provided for special situations: --- a-numaux-darwin For OS/X (special handling of sin/cos for accuracy) +-- a-numaux-darwin For PowerPC/Darwin (special handling of sin/cos) -- a-numaux-libc-x86 For the x86, using 80-bit long double format --- a-numaux-x86 For the x86, using 64-bit IEEE (inline asm statements) +-- a-numaux-x86 For the x86, using 80-bit long double format with +-- inline asm statements -- a-numaux-vxworks For use on VxWorks (where we have no libm.a library) package Ada.Numerics.Aux is @@ -50,7 +51,7 @@ package Ada.Numerics.Aux is pragma Linker_Options ("-lm"); - type Double is digits 15; + type Double is new Long_Float; -- Type Double is the type used to call the C routines -- We import these functions directly from C. Note that we label them diff --git a/gcc/ada/erroutc.adb b/gcc/ada/erroutc.adb index f637083cb06..cf1095c7ae5 100644 --- a/gcc/ada/erroutc.adb +++ b/gcc/ada/erroutc.adb @@ -1447,7 +1447,7 @@ package body Erroutc is Specific_Warnings.Append ((Start => Loc, Msg => new String'(Msg), - Stop => Source_Last (Current_Source_File), + Stop => Source_Last (Get_Source_File_Index (Loc)), Reason => Reason, Open => True, Used => Used, @@ -1531,7 +1531,7 @@ package body Erroutc is Warnings.Append ((Start => Loc, - Stop => Source_Last (Current_Source_File), + Stop => Source_Last (Get_Source_File_Index (Loc)), Reason => Reason)); end Set_Warnings_Mode_Off; diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 6a0b0d53244..7e03e4ed640 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -4274,7 +4274,7 @@ package body Exp_Aggr is -- Check whether all components of the aggregate are compile-time known -- values, and can be passed as is to the back-end without further -- expansion. - -- An Iterated_component_Association is treated as non-static, but there + -- An Iterated_Component_Association is treated as non-static, but there -- are possibilities for optimization here. function Flatten diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 87dd3de4c13..63a1e601def 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -2950,6 +2950,11 @@ package body Exp_Ch3 is Exp := Unchecked_Convert_To (RTE (RE_Dispatching_Domain_Access), Exp); + + -- Conversion for Secondary_Stack_Size value + + elsif Nam = Name_Secondary_Stack_Size then + Exp := Convert_To (RTE (RE_Size_Type), Exp); end if; Actions := Build_Assignment (Id, Exp); diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index cd555b42d48..5267024bc6e 100644 --- a/gcc/ada/exp_ch5.adb +++ b/gcc/ada/exp_ch5.adb @@ -1642,10 +1642,16 @@ package body Exp_Ch5 is -- The expression will be reanalyzed when the enclosing assignment -- is reanalyzed, so reset the entity, which may be a temporary -- created during analysis, e.g. a loop variable for an iterated - -- component association. + -- component association. However, if entity is callable then + -- resolution has established its proper identity (including in + -- rewritten prefixed calls) so we must preserve it. elsif Is_Entity_Name (N) then - Set_Entity (N, Empty); + if Present (Entity (N)) + and then not Is_Overloadable (Entity (N)) + then + Set_Entity (N, Empty); + end if; end if; Set_Analyzed (N, False); diff --git a/gcc/ada/exp_prag.adb b/gcc/ada/exp_prag.adb index b83cc38da21..b8490a74a2c 100644 --- a/gcc/ada/exp_prag.adb +++ b/gcc/ada/exp_prag.adb @@ -168,7 +168,7 @@ package body Exp_Prag is -- the back end or the expander here does not get overenthusiastic and -- start processing such a pragma! - if Should_Ignore_Pragma (Pname) then + if Should_Ignore_Pragma_Sem (N) then Rewrite (N, Make_Null_Statement (Sloc (N))); return; end if; diff --git a/gcc/ada/lib.adb b/gcc/ada/lib.adb index 0ba9f9ad245..ae9e29aa927 100644 --- a/gcc/ada/lib.adb +++ b/gcc/ada/lib.adb @@ -893,6 +893,22 @@ package body Lib is end if; end In_Extended_Main_Source_Unit; + ---------------------- + -- In_Internal_Unit -- + ---------------------- + + function In_Internal_Unit (N : Node_Or_Entity_Id) return Boolean is + begin + return In_Internal_Unit (Sloc (N)); + end In_Internal_Unit; + + function In_Internal_Unit (S : Source_Ptr) return Boolean is + Unit : constant Unit_Number_Type := Get_Source_Unit (S); + File : constant File_Name_Type := Unit_File_Name (Unit); + begin + return Is_Internal_File_Name (File); + end In_Internal_Unit; + ------------------------ -- In_Predefined_Unit -- ------------------------ diff --git a/gcc/ada/lib.ads b/gcc/ada/lib.ads index a6cfd5dff7f..3ee4125f59f 100644 --- a/gcc/ada/lib.ads +++ b/gcc/ada/lib.ads @@ -599,6 +599,11 @@ package Lib is function In_Predefined_Unit (S : Source_Ptr) return Boolean; -- Same function as above but argument is a source pointer + function In_Internal_Unit (N : Node_Or_Entity_Id) return Boolean; + function In_Internal_Unit (S : Source_Ptr) return Boolean; + -- Same as In_Predefined_Unit, except units in the GNAT hierarchy are + -- included. + function In_Same_Code_Unit (N1, N2 : Node_Or_Entity_Id) return Boolean; pragma Inline (In_Same_Code_Unit); -- Determines if the two nodes or entities N1 and N2 are in the same diff --git a/gcc/ada/par-prag.adb b/gcc/ada/par-prag.adb index 02223c8c686..e3a1b3ff59f 100644 --- a/gcc/ada/par-prag.adb +++ b/gcc/ada/par-prag.adb @@ -294,7 +294,7 @@ begin -- Ignore pragma previously flagged by Ignore_Pragma - if Should_Ignore_Pragma (Prag_Name) then + if Should_Ignore_Pragma_Par (Prag_Name) then return Pragma_Node; end if; diff --git a/gcc/ada/s-osinte-freebsd.ads b/gcc/ada/s-osinte-freebsd.ads index a5ba5f188c8..12854445bd3 100644 --- a/gcc/ada/s-osinte-freebsd.ads +++ b/gcc/ada/s-osinte-freebsd.ads @@ -7,7 +7,7 @@ -- S p e c -- -- -- -- Copyright (C) 1991-1994, Florida State University -- --- Copyright (C) 1995-2015, Free Software Foundation, Inc. -- +-- Copyright (C) 1995-2016, 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- -- diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index ddb70384394..5e6642988a4 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -4914,6 +4914,7 @@ package body Sem_Ch4 is -- expression of the same type, unless the selector designates a -- public operation (otherwise that would represent an attempt to -- reach an internal entity of another synchronized object). + -- This is legal if prefix is an access to such type and there is -- a dereference, or is a component with a dereferenced prefix. -- It is also legal if the prefix is a component of a task type, @@ -4943,6 +4944,21 @@ package body Sem_Ch4 is Set_Etype (Sel, Any_Type); return; end if; + + -- Another special case: the prefix may denote an object of the type + -- (but not a type) in which case this is an external call and the + -- operation must be public. + + elsif In_Scope + and then Is_Object_Reference (Original_Node (Prefix (N))) + and then Is_Private_Op + then + Error_Msg_NE + ("invalid reference to private operation of some object of " + & "type &", N, Type_To_Use); + Set_Entity (Sel, Any_Id); + Set_Etype (Sel, Any_Type); + return; end if; -- If there is no visible entity with the given name or none of the diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 4549e8afd3b..aebc0a625e2 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -10389,7 +10389,7 @@ package body Sem_Prag is -- Ignore pragma if Ignore_Pragma applies - if Should_Ignore_Pragma (Pname) then + if Should_Ignore_Pragma_Sem (N) then return; end if; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index ebf585a4a3e..ff3ee6e17b0 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -20638,16 +20638,34 @@ package body Sem_Util is Set_Alignment (T1, Alignment (T2)); end Set_Size_Info; + ------------------------------ + -- Should_Ignore_Pragma_Par -- + ------------------------------ + + function Should_Ignore_Pragma_Par (Prag_Name : Name_Id) return Boolean is + pragma Assert (Compiler_State = Parsing); + -- This one can't work during semantic analysis, because we don't have a + -- correct Current_Source_File. + + Result : constant Boolean := + Get_Name_Table_Boolean3 (Prag_Name) + and then not Is_Internal_File_Name (File_Name (Current_Source_File)); + begin + return Result; + end Should_Ignore_Pragma_Par; + -------------------------- - -- Should_Ignore_Pragma -- + -- Should_Ignore_Pragma_Sem -- -------------------------- - function Should_Ignore_Pragma (Prag_Name : Name_Id) return Boolean is + function Should_Ignore_Pragma_Sem (N : Node_Id) return Boolean is + pragma Assert (Compiler_State = Analyzing); + Prag_Name : constant Name_Id := Pragma_Name (N); + Result : constant Boolean := + Get_Name_Table_Boolean3 (Prag_Name) and then not In_Internal_Unit (N); begin - return - not Is_Internal_File_Name (File_Name (Current_Source_File)) - and then Get_Name_Table_Boolean3 (Prag_Name); - end Should_Ignore_Pragma; + return Result; + end Should_Ignore_Pragma_Sem; -------------------- -- Static_Boolean -- diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 014cb6379e1..9b4ba0e118b 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -2359,10 +2359,12 @@ package Sem_Util is function Scope_Is_Transient return Boolean; -- True if the current scope is transient - function Should_Ignore_Pragma (Prag_Name : Name_Id) return Boolean; + function Should_Ignore_Pragma_Par (Prag_Name : Name_Id) return Boolean; + function Should_Ignore_Pragma_Sem (N : Node_Id) return Boolean; -- True if we should ignore pragmas with the specified name. In particular, -- this returns True if pragma Ignore_Pragma applies, and we are not in a - -- predefined unit. + -- predefined unit. The _Par version should be called only from the parser; + -- the _Sem version should be called only during semantic analysis. function Static_Boolean (N : Node_Id) return Uint; -- This function analyzes the given expression node and then resolves it diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index a1741fb0d56..ae884e08bbd 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -982,7 +982,7 @@ package Sinfo is -- Compile_Time_Known_Aggregate (Flag18-Sem) -- Present in N_Aggregate nodes. Set for aggregates which can be fully -- evaluated at compile time without raising constraint error. Such - -- aggregates can be passed as is the back end without any expansion. + -- aggregates can be passed as is to the back end without any expansion. -- See Exp_Aggr for specific conditions under which this flag gets set. -- Componentwise_Assignment (Flag14-Sem) diff --git a/gcc/ada/urealp.adb b/gcc/ada/urealp.adb index b839933bdae..235a10d54fc 100644 --- a/gcc/ada/urealp.adb +++ b/gcc/ada/urealp.adb @@ -1468,14 +1468,17 @@ package body Urealp is Write_Str ("#1.0#E"); UI_Write (-Val.Den); - -- Other constants with a base other than 10 are written using one - -- of the following forms, depending on the sign of the number - -- and the sign of the exponent (= minus denominator value) + -- Other constants with a base other than 10 are written using one of + -- the following forms, depending on the sign of the number and the + -- sign of the exponent (= minus denominator value). See that we are + -- replacing the division by a multiplication (updating accordingly the + -- sign of the exponent) to generate an expression whose computation + -- does not cause a division by 0 when base**exponent is very small. - -- numerator.0/base**exponent - -- numerator.0/base**-exponent + -- numerator.0*base**exponent + -- numerator.0*base**-exponent - -- And of course an exponent of 0 can be omitted + -- And of course an exponent of 0 can be omitted. elsif Val.Rbase /= 0 then if Brackets then @@ -1486,14 +1489,16 @@ package body Urealp is Write_Str (".0"); if Val.Den /= 0 then - Write_Char ('/'); + Write_Char ('*'); Write_Int (Val.Rbase); Write_Str ("**"); if Val.Den <= 0 then UI_Write (-Val.Den, Decimal); else + Write_Str ("(-"); UI_Write (Val.Den, Decimal); + Write_Char (')'); end if; end if; -- 2.30.2