diff options
Diffstat (limited to 'gcc/ada')
| -rw-r--r-- | gcc/ada/ChangeLog | 39 | ||||
| -rw-r--r-- | gcc/ada/a-tienio.adb | 16 | ||||
| -rwxr-xr-x | gcc/ada/a-wichha.ads | 5 | ||||
| -rw-r--r-- | gcc/ada/a-wichun.ads | 3 | ||||
| -rwxr-xr-x | gcc/ada/a-zchhan.ads | 5 | ||||
| -rwxr-xr-x | gcc/ada/a-zchuni.ads | 3 | ||||
| -rw-r--r-- | gcc/ada/gnat_rm.texi | 8 | ||||
| -rw-r--r-- | gcc/ada/s-rpc.ads | 6 | ||||
| -rwxr-xr-x | gcc/ada/s-utf_32.adb | 15 | ||||
| -rwxr-xr-x | gcc/ada/s-utf_32.ads | 3 | ||||
| -rw-r--r-- | gcc/ada/sem_ch12.adb | 8 | ||||
| -rw-r--r-- | gcc/ada/sem_ch3.adb | 29 | ||||
| -rw-r--r-- | gcc/ada/sem_ch4.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/sem_prag.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/sinfo.adb | 16 | ||||
| -rw-r--r-- | gcc/ada/sinfo.ads | 15 |
16 files changed, 128 insertions, 49 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 5e7685796a4..67905722c59 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,42 @@ +2012-01-06 Robert Dewar <dewar@adacore.com> + + * a-wichha.ads, a-wichun.ads, a-zchhan.ads, a-zchuni.ads, + s-utf_32.ads: Add pragma Pure + * s-utf_32.adb: Suppress warnings on non-static constants (now + that this is Pure). + +2012-01-06 Bob Duff <duff@adacore.com> + + * s-rpc.ads (Read, Write): Add overriding indicators. + +2012-01-06 Robert Dewar <dewar@adacore.com> + + * gnat_rm.texi: Add documentation for conventions + Ada_Pass_By_Copy and Ada_Pass_By_Reference. + +2012-01-06 Gary Dismukes <dismukes@adacore.com> + + * a-tienio.adb (Put): Add exception message on + raise statements. Remove unneeded blocks and object declarations. + +2012-01-06 Robert Dewar <dewar@adacore.com> + + * sem_prag.adb: Minor reformatting. + +2012-01-06 Ed Schonberg <schonberg@adacore.com> + + * sinfo.ads, sinfo.adb (Has_Prefixed_Call): New flag to indicate + that a selected component within a generic unit has been resolved + as a prefixed call with local references. + * sem_ch3.adb (Is_Visible_Component): In an instance body a selected + component is always visible. + * sem_ch4.adb (Analyze_Selected_Component): If the node is a + prefixed call in an instance, do not look for visible components + of the type. + * sem_ch12.adb (Reset_Entity): If a selected component has resolved + to a prefixed call, mark the node accordingly when prefix and + selector are local references. + 2012-01-02 Eric Botcazou <ebotcazou@adacore.com> * gnatvsn.ads (Current_Year): Bump to 2012. diff --git a/gcc/ada/a-tienio.adb b/gcc/ada/a-tienio.adb index a643f87b3b1..1b9ab8bcd64 100644 --- a/gcc/ada/a-tienio.adb +++ b/gcc/ada/a-tienio.adb @@ -101,14 +101,10 @@ package body Ada.Text_IO.Enumeration_IO is -- checks suppressed, which includes instantiated generics. if not Item'Valid then - raise Constraint_Error; + raise Constraint_Error with "invalid enumeration value"; end if; - declare - Image : constant String := Enum'Image (Item); - begin - Aux.Put (File, Image, Width, Set); - end; + Aux.Put (File, Enum'Image (Item), Width, Set); end Put; procedure Put @@ -132,14 +128,10 @@ package body Ada.Text_IO.Enumeration_IO is -- checks suppressed, which includes instantiated generics. if not Item'Valid then - raise Constraint_Error; + raise Constraint_Error with "invalid enumeration value"; end if; - declare - Image : constant String := Enum'Image (Item); - begin - Aux.Puts (To, Image, Set); - end; + Aux.Puts (To, Enum'Image (Item), Set); end Put; end Ada.Text_IO.Enumeration_IO; diff --git a/gcc/ada/a-wichha.ads b/gcc/ada/a-wichha.ads index 50c3ff8ed19..a9cff259f7a 100755 --- a/gcc/ada/a-wichha.ads +++ b/gcc/ada/a-wichha.ads @@ -14,6 +14,11 @@ ------------------------------------------------------------------------------ package Ada.Wide_Characters.Handling is + pragma Pure; + -- This package is clearly intended to be Pure, by analogy with the + -- base Ada.Characters.Handling package. The version in the RM does + -- not yet have this pragma, but that is a clear omission. This will + -- be fixed in a future version of AI05-0266-1. function Is_Control (Item : Wide_Character) return Boolean; pragma Inline (Is_Control); diff --git a/gcc/ada/a-wichun.ads b/gcc/ada/a-wichun.ads index 08ac83d6f67..a2f78e39367 100644 --- a/gcc/ada/a-wichun.ads +++ b/gcc/ada/a-wichun.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2005-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 2005-2011, 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,6 +37,7 @@ with System.UTF_32; package Ada.Wide_Characters.Unicode is + pragma Pure; -- The following type defines the categories from the unicode definitions. -- The one addition we make is Fe, which represents the characters FFFE diff --git a/gcc/ada/a-zchhan.ads b/gcc/ada/a-zchhan.ads index 973a7803dce..4c78dcd070c 100755 --- a/gcc/ada/a-zchhan.ads +++ b/gcc/ada/a-zchhan.ads @@ -14,6 +14,11 @@ ------------------------------------------------------------------------------ package Ada.Wide_Wide_Characters.Handling is + pragma Pure; + -- This package is clearly intended to be Pure, by analogy with the + -- base Ada.Characters.Handling package. The version in the RM does + -- not yet have this pragma, but that is a clear omission. This will + -- be fixed in a future version of AI05-0266-1. function Is_Control (Item : Wide_Wide_Character) return Boolean; pragma Inline (Is_Control); diff --git a/gcc/ada/a-zchuni.ads b/gcc/ada/a-zchuni.ads index 10506957a29..bb2af79fe77 100755 --- a/gcc/ada/a-zchuni.ads +++ b/gcc/ada/a-zchuni.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2005-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 2005-2011, 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- -- @@ -34,6 +34,7 @@ with System.UTF_32; package Ada.Wide_Wide_Characters.Unicode is + pragma Pure; -- The following type defines the categories from the unicode definitions. -- The one addition we make is Fe, which represents the characters FFFE diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index 781e0ae6cc6..908b177187b 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -9608,6 +9608,14 @@ The following convention names are supported @table @code @item Ada Ada +@item Ada_Pass_By_Copy +Allowed for any types except by-reference types such as limited +records. Compatible with convention Ada, but causes any parameters +with this convention to be passed by copy. +@item Ada_Pass_By_Reference +Allowed for any types except by-copy types such as scalars. +Compatible with convention Ada, but causes any parameters +with this convention to be passed by reference. @item Assembler Assembly language @item Asm diff --git a/gcc/ada/s-rpc.ads b/gcc/ada/s-rpc.ads index fa883ecbbc1..93ad69bfc5e 100644 --- a/gcc/ada/s-rpc.ads +++ b/gcc/ada/s-rpc.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- -- -- -- This specification is derived from the Ada Reference Manual for use with -- -- GNAT. The copyright notice above, and the license provisions that follow -- @@ -52,12 +52,12 @@ package System.RPC is (Initial_Size : Ada.Streams.Stream_Element_Count) is new Ada.Streams.Root_Stream_Type with private; - procedure Read + overriding procedure Read (Stream : in out Params_Stream_Type; Item : out Ada.Streams.Stream_Element_Array; Last : out Ada.Streams.Stream_Element_Offset); - procedure Write + overriding procedure Write (Stream : in out Params_Stream_Type; Item : Ada.Streams.Stream_Element_Array); diff --git a/gcc/ada/s-utf_32.adb b/gcc/ada/s-utf_32.adb index f044b9bcc70..676d0e3ccc9 100755 --- a/gcc/ada/s-utf_32.adb +++ b/gcc/ada/s-utf_32.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2005-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 2005-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- -- @@ -34,6 +34,13 @@ pragma Compiler_Unit; pragma Style_Checks (Off); -- Allow long lines in this unit +-- pragma Warnings (Off, "non-static constant in preelaborated unit"); +-- We need this to be pure, and the three constants in question are not a +-- real problem, they are completely known at compile time. This pragma +-- is commented out for now, because we still want to be able to bootstrap +-- with old versions of the compiler that did not support this form. We +-- have added additional pragma Warnings (Off/On) for now ??? + package body System.UTF_32 is ---------------------- @@ -1850,6 +1857,9 @@ package body System.UTF_32 is (16#F0000#, 16#FFFFD#), -- (Co) <Plane 15 Private Use, First> .. <Plane 15 Private Use, Last> (16#100000#, 16#10FFFD#)); -- (Co) <Plane 16 Private Use, First> .. <Plane 16 Private Use, Last> + pragma Warnings (Off); + -- Temporary, until pragma at start can be activated ??? + -- The following array is parallel to the Unicode_Ranges table above. For -- each entry in the Unicode_Ranges table, there is a corresponding entry -- in the following table indicating the corresponding unicode category. @@ -6060,6 +6070,9 @@ package body System.UTF_32 is 40, -- DESERET CAPITAL LETTER LONG I .. DESERET CAPITAL LETTER EW 32); -- TAG LATIN CAPITAL LETTER A .. TAG LATIN CAPITAL LETTER Z + pragma Warnings (On); + -- Temporary until pragma Warnings at start can be activated ??? + -- The following is a list of the 10646 names for CAPITAL LETTER entries -- that have no matching SMALL LETTER entry and are thus not folded diff --git a/gcc/ada/s-utf_32.ads b/gcc/ada/s-utf_32.ads index 4cdbf95279e..4f61a014788 100755 --- a/gcc/ada/s-utf_32.ads +++ b/gcc/ada/s-utf_32.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2005-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 2005-2011, 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- -- @@ -44,6 +44,7 @@ pragma Compiler_Unit; package System.UTF_32 is + pragma Pure; type UTF_32 is range 0 .. 16#7FFF_FFFF#; -- So far, the only defined character codes are in 0 .. 16#01_FFFF# diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 3557ed813c3..cbc8b4df868 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -12676,6 +12676,7 @@ package body Sem_Ch12 is Save_Entity_Descendants (N); else + Set_Is_Prefixed_Call (Parent (N)); Set_Associated_Node (N, Empty); Set_Etype (N, Empty); end if; @@ -12683,10 +12684,13 @@ package body Sem_Ch12 is -- In Ada 2005, X.F may be a call to a primitive operation, -- rewritten as F (X). This rewriting will be done again in an -- instance, so keep the original node. Global entities will be - -- captured as for other constructs. + -- captured as for other constructs. Indicate that this must + -- resolve as a call, to prevent accidental overloading in the + -- instance, if both a component and a primitive operation appear + -- as candidates. else - null; + Set_Is_Prefixed_Call (Parent (N)); end if; -- Entity is local. Reset in generic unit, so that node is resolved diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 50c9d3d6e69..88ef2674dc3 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -16300,34 +16300,11 @@ package body Sem_Ch3 is then return True; - -- If we are in the body of an instantiation, the component is visible - -- if the parent type is non-private, or in an enclosing scope. The - -- scope stack is not present when analyzing an instance body, so we - -- must inspect the chain of scopes explicitly. + -- In the body of an instantiation, no need to check for the visibility + -- of a component. elsif In_Instance_Body then - if not Is_Private_Type (Scope (C)) then - return True; - - else - declare - S : Entity_Id; - - begin - S := Current_Scope; - while Present (S) - and then S /= Standard_Standard - loop - if S = Type_Scope then - return True; - end if; - - S := Scope (S); - end loop; - - return False; - end; - end if; + return True; -- If the component has been declared in an ancestor which is currently -- a private type, then it is not visible. The same applies if the diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 99f29668cd6..5ade3a88166 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -3858,8 +3858,10 @@ package body Sem_Ch4 is elsif Is_Record_Type (Prefix_Type) then -- Find component with given name + -- In an instance, if the node is known as a prefixed call, do + -- not examine components whose visibility may be accidental. - while Present (Comp) loop + while Present (Comp) and then not Is_Prefixed_Call (N) loop if Chars (Comp) = Chars (Sel) and then Is_Visible_Component (Comp) then diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 0afe05cd467..8ac54a51f3c 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -14501,7 +14501,7 @@ package body Sem_Prag is -- the formal may be wrapped in a conversion if the -- actual is a conversion. Retrieve the real entity name. - if (In_Instance_Body or else In_Inlined_Body) + if (In_Instance_Body or In_Inlined_Body) and then Nkind (E_Id) = N_Unchecked_Type_Conversion then E_Id := Expression (E_Id); diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb index 440cf02a2e7..96b45709c43 100644 --- a/gcc/ada/sinfo.adb +++ b/gcc/ada/sinfo.adb @@ -1838,6 +1838,14 @@ package body Sinfo is return Flag13 (N); end Is_Power_Of_2_For_Shift; + function Is_Prefixed_Call + (N : Node_Id) return Boolean is + begin + pragma Assert (False + or else NT (N).Nkind = N_Selected_Component); + return Flag17 (N); + end Is_Prefixed_Call; + function Is_Protected_Subprogram_Body (N : Node_Id) return Boolean is begin @@ -4910,6 +4918,14 @@ package body Sinfo is Set_Flag13 (N, Val); end Set_Is_Power_Of_2_For_Shift; + procedure Set_Is_Prefixed_Call + (N : Node_Id; Val : Boolean := True) is + begin + pragma Assert (False + or else NT (N).Nkind = N_Selected_Component); + Set_Flag17 (N, Val); + end Set_Is_Prefixed_Call; + procedure Set_Is_Protected_Subprogram_Body (N : Node_Id; Val : Boolean := True) is begin diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index ce4a31c8af9..3d1809be93d 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -1335,6 +1335,12 @@ package Sinfo is -- conditions holds, and the flag is set, then the division or -- multiplication can be (and is) converted to a shift. + -- Is_Prefixed_Call (Flag17-Sem) + -- This flag is set in a selected component within a generic unit, if + -- it resolves to a prefixed call to a primitive operation. The flag + -- is used to prevent accidental overloadings in an instance, when a + -- primitive operation and a private record component may be homographs. + -- Is_Protected_Subprogram_Body (Flag7-Sem) -- A flag set in a Subprogram_Body block to indicate that it is the -- implementation of a protected subprogram. Such a body needs cleanup @@ -3249,6 +3255,7 @@ package Sinfo is -- Associated_Node (Node4-Sem) -- Do_Discriminant_Check (Flag13-Sem) -- Is_In_Discriminant_Check (Flag11-Sem) + -- Is_Prefixed_Call (Flag17-Sem) -- Atomic_Sync_Required (Flag14-Sem) -- plus fields for expression @@ -8653,6 +8660,9 @@ package Sinfo is function Is_Power_Of_2_For_Shift (N : Node_Id) return Boolean; -- Flag13 + function Is_Prefixed_Call + (N : Node_Id) return Boolean; -- Flag17 + function Is_Protected_Subprogram_Body (N : Node_Id) return Boolean; -- Flag7 @@ -9631,6 +9641,9 @@ package Sinfo is procedure Set_Is_Power_Of_2_For_Shift (N : Node_Id; Val : Boolean := True); -- Flag13 + procedure Set_Is_Prefixed_Call + (N : Node_Id; Val : Boolean := True); -- Flag17 + procedure Set_Is_Protected_Subprogram_Body (N : Node_Id; Val : Boolean := True); -- Flag7 @@ -11971,6 +11984,7 @@ package Sinfo is pragma Inline (Is_Null_Loop); pragma Inline (Is_Overloaded); pragma Inline (Is_Power_Of_2_For_Shift); + pragma Inline (Is_Prefixed_Call); pragma Inline (Is_Protected_Subprogram_Body); pragma Inline (Is_Static_Coextension); pragma Inline (Is_Static_Expression); @@ -12293,6 +12307,7 @@ package Sinfo is pragma Inline (Set_Is_Null_Loop); pragma Inline (Set_Is_Overloaded); pragma Inline (Set_Is_Power_Of_2_For_Shift); + pragma Inline (Set_Is_Prefixed_Call); pragma Inline (Set_Is_Protected_Subprogram_Body); pragma Inline (Set_Has_Self_Reference); pragma Inline (Set_Is_Static_Coextension); |