From 2590ef129b3c7fa8dd899eed69e97b418411f40e Mon Sep 17 00:00:00 2001 From: Robert Dewar Date: Mon, 14 Oct 2013 13:51:45 +0000 Subject: [PATCH] sem_res.adb: Minor fix to error message text. 2013-10-14 Robert Dewar * sem_res.adb: Minor fix to error message text. * errout.ads, erroutc.ads: Minor reformatting. * s-ststop.ads, s-stratt.ads: Clean up documentation of block IO mode for streams. * s-stratt-xdr.adb: Minor comment update. From-SVN: r203559 --- gcc/ada/ChangeLog | 8 ++++++++ gcc/ada/errout.ads | 2 ++ gcc/ada/erroutc.ads | 3 ++- gcc/ada/s-stratt-xdr.adb | 6 +++++- gcc/ada/s-stratt.ads | 31 ++++++++++++++----------------- gcc/ada/s-ststop.ads | 23 +++++++++++++++++------ gcc/ada/sem_res.adb | 33 ++++++++++++++++++--------------- 7 files changed, 66 insertions(+), 40 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index d155557eff5..8cd9a9dd98d 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,11 @@ +2013-10-14 Robert Dewar + + * sem_res.adb: Minor fix to error message text. + * errout.ads, erroutc.ads: Minor reformatting. + * s-ststop.ads, s-stratt.ads: Clean up documentation of block IO + mode for streams. + * s-stratt-xdr.adb: Minor comment update. + 2013-10-14 Robert Dewar * sem_aux.adb, sem_aux.ads, sem_prag.adb: Minor reformatting. diff --git a/gcc/ada/errout.ads b/gcc/ada/errout.ads index 0973b6801cc..e268d1f58d7 100644 --- a/gcc/ada/errout.ads +++ b/gcc/ada/errout.ads @@ -313,6 +313,8 @@ package Errout is -- taken as an Ada reserved word, and are converted to the default -- case for reserved words (see Scans package spec). Surrounding -- quotes are added unless manual quotation mode is currently set. + -- RM and SPARK are special exceptions, they are never treated as + -- keywords, and just appear verbatim, with no surrounding quotes. -- Insertion character ` (Backquote: set manual quotation mode) -- The backquote character always appears in pairs. Each backquote of diff --git a/gcc/ada/erroutc.ads b/gcc/ada/erroutc.ads index 02101852d44..647e58bafdd 100644 --- a/gcc/ada/erroutc.ads +++ b/gcc/ada/erroutc.ads @@ -427,7 +427,8 @@ package Erroutc is -- Handle reserved word insertion (upper case letters). The Text argument -- is the current error message input text, and J is an index which on -- entry points to the first character of the reserved word, and on exit - -- points past the last character of the reserved word. + -- points past the last character of the reserved word. Note that RM and + -- SPARK are treated specially and not considered to be keywords. procedure Set_Msg_Insertion_Run_Time_Name; -- If package System contains a definition for Run_Time_Name (see package diff --git a/gcc/ada/s-stratt-xdr.adb b/gcc/ada/s-stratt-xdr.adb index d63c2514779..ae4c9b37e7c 100644 --- a/gcc/ada/s-stratt-xdr.adb +++ b/gcc/ada/s-stratt-xdr.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1996-2012, Free Software Foundation, Inc. -- +-- Copyright (C) 1996-2013, Free Software Foundation, Inc. -- -- -- -- GARLIC 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- -- @@ -283,6 +283,10 @@ package body System.Stream_Attributes is -- Block_IO_OK -- ----------------- + -- We must inhibit Block_IO, because in XDR mode, each element is output + -- according to XDR requirements, which is not at all the same as writing + -- the whole array in one block. + function Block_IO_OK return Boolean is begin return False; diff --git a/gcc/ada/s-stratt.ads b/gcc/ada/s-stratt.ads index 498700e06b5..ce1b4f5e124 100644 --- a/gcc/ada/s-stratt.ads +++ b/gcc/ada/s-stratt.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2010, 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- -- @@ -88,7 +88,6 @@ package System.Stream_Attributes is -- the first subtype is specified, or where an enumeration representation -- clause is given, these three types are treated like any other cases -- of enumeration types, as described above. - -- for --------------------- -- Input Functions -- @@ -114,8 +113,8 @@ package System.Stream_Attributes is function I_SF (Stream : not null access RST) return Short_Float; function I_SI (Stream : not null access RST) return Short_Integer; function I_SSI (Stream : not null access RST) return Short_Short_Integer; - function I_SSU (Stream : not null access RST) - return UST.Short_Short_Unsigned; + function I_SSU (Stream : not null access RST) return + UST.Short_Short_Unsigned; function I_SU (Stream : not null access RST) return UST.Short_Unsigned; function I_U (Stream : not null access RST) return UST.Unsigned; function I_WC (Stream : not null access RST) return Wide_Character; @@ -125,10 +124,10 @@ package System.Stream_Attributes is -- Output Procedures -- ----------------------- - -- Procedures for S'Write attribute. These procedures are also used - -- for 'Output, since for elementary types there is no difference - -- between 'Write and 'Output because there are no discriminants - -- or bounds to be written. + -- Procedures for S'Write attribute. These procedures are also used for + -- 'Output, since for elementary types there is no difference between + -- 'Write and 'Output because there are no discriminants or bounds to + -- be written. procedure W_AD (Stream : not null access RST; Item : Fat_Pointer); procedure W_AS (Stream : not null access RST; Item : Thin_Pointer); @@ -140,17 +139,15 @@ package System.Stream_Attributes is procedure W_LI (Stream : not null access RST; Item : Long_Integer); procedure W_LLF (Stream : not null access RST; Item : Long_Long_Float); procedure W_LLI (Stream : not null access RST; Item : Long_Long_Integer); - procedure W_LLU (Stream : not null access RST; - Item : UST.Long_Long_Unsigned); + procedure W_LLU (Stream : not null access RST; Item : + UST.Long_Long_Unsigned); procedure W_LU (Stream : not null access RST; Item : UST.Long_Unsigned); procedure W_SF (Stream : not null access RST; Item : Short_Float); procedure W_SI (Stream : not null access RST; Item : Short_Integer); - procedure W_SSI (Stream : not null access RST; - Item : Short_Short_Integer); - procedure W_SSU (Stream : not null access RST; - Item : UST.Short_Short_Unsigned); - procedure W_SU (Stream : not null access RST; - Item : UST.Short_Unsigned); + procedure W_SSI (Stream : not null access RST; Item : Short_Short_Integer); + procedure W_SSU (Stream : not null access RST; Item : + UST.Short_Short_Unsigned); + procedure W_SU (Stream : not null access RST; Item : UST.Short_Unsigned); procedure W_U (Stream : not null access RST; Item : UST.Unsigned); procedure W_WC (Stream : not null access RST; Item : Wide_Character); procedure W_WWC (Stream : not null access RST; Item : Wide_Wide_Character); @@ -160,7 +157,7 @@ package System.Stream_Attributes is -- distributed with GNAT, and s-stratt-xdr.adb, which is based on the XDR -- standard. Both bodies share the same spec. The role of this function is -- to indicate whether the current version of System.Stream_Attributes - -- supports block IO. + -- supports block IO. See System.Strings.Stream_Ops (s-ststop) for details. private pragma Inline (I_AD); diff --git a/gcc/ada/s-ststop.ads b/gcc/ada/s-ststop.ads index db7059069b7..0c7813ffb9a 100644 --- a/gcc/ada/s-ststop.ads +++ b/gcc/ada/s-ststop.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2009, Free Software Foundation, Inc. -- +-- Copyright (C) 2009-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- -- @@ -30,22 +30,33 @@ ------------------------------------------------------------------------------ -- This package provides subprogram implementations of stream attributes for --- the following types: +-- the following types using a "block IO" approach in which the entire data +-- item is written in one operation, instead of writing individual characters. + -- Ada.String -- Ada.Wide_String -- Ada.Wide_Wide_String --- + -- The compiler will generate references to the subprograms in this package -- when expanding stream attributes for the above mentioned types. Example: --- + -- String'Output (Some_Stream, Some_String); --- + -- will be expanded into: --- + -- String_Output (Some_Stream, Some_String); -- or -- String_Output_Blk_IO (Some_Stream, Some_String); +-- This expansion occurs only if System.Stream_Attributes.Block_IO_OK returns +-- True, indicating that this approach is compatible with the expectations of +-- System.Stream_Attributes. For the default implementation of this package, +-- there is no difference between writing the elements one by one using the +-- default output routine for the element type and writing the whole array +-- using block IO. + +-- In addition, + pragma Compiler_Unit; with Ada.Streams; diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 3cb49f416a7..430766d25bc 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -3634,7 +3634,7 @@ package body Sem_Res is then Error_Msg_N ("conversion between unrelated limited array types " - & "not allowed (\A\I-00246)", A); + & "not allowed ('A'I-00246)", A); if Is_Limited_Type (Etype (F)) then Explain_Limited_Type (Etype (F), A); @@ -3666,8 +3666,8 @@ package body Sem_Res is then New_Itype := Create_Itype (E_Anonymous_Access_Type, A); Set_Etype (New_Itype, Etype (A)); - Set_Directly_Designated_Type (New_Itype, - Directly_Designated_Type (Etype (A))); + Set_Directly_Designated_Type + (New_Itype, Directly_Designated_Type (Etype (A))); Set_Etype (A, New_Itype); end if; @@ -3701,7 +3701,7 @@ package body Sem_Res is if Is_Tagged_Type (F_Typ) and then (Is_Concurrent_Type (F_Typ) - or else Is_Concurrent_Record_Type (F_Typ)) + or else Is_Concurrent_Record_Type (F_Typ)) then -- If the actual is overloaded, look for an interpretation -- that has a synchronized type. @@ -3768,10 +3768,10 @@ package body Sem_Res is Resolve (A, Etype (F)); end if; end; + + -- Not a synchronized operation + else - - -- not a synchronized operation. - Resolve (A, Etype (F)); end if; end if; @@ -3937,10 +3937,11 @@ package body Sem_Res is if Is_Subprogram (Current_Scope) and then (Is_Invariant_Procedure (Current_Scope) - or else Is_Predicate_Function (Current_Scope)) + or else Is_Predicate_Function (Current_Scope)) then - Error_Msg_N ("function used in predicate cannot " & - "modify its argument", F); + Error_Msg_N + ("function used in predicate cannot " + & "modify its argument", F); end if; end if; @@ -4164,7 +4165,7 @@ package body Sem_Res is and then (Is_Class_Wide_Type (Designated_Type (A_Typ)) or else (Nkind (A) = N_Attribute_Reference and then - Is_Class_Wide_Type (Etype (Prefix (A))))) + Is_Class_Wide_Type (Etype (Prefix (A))))) and then not Is_Class_Wide_Type (Designated_Type (F_Typ)) and then not Is_Controlling_Formal (F) @@ -4188,12 +4189,14 @@ package body Sem_Res is Eval_Actual (A); -- If it is a named association, treat the selector_name as a - -- proper identifier, and mark the corresponding entity. Ignore - -- this reference in SPARK mode, as it refers to an entity not in - -- scope at the point of reference, so the reference should be - -- ignored for computing effects of subprograms. + -- proper identifier, and mark the corresponding entity. if Nkind (Parent (A)) = N_Parameter_Association + + -- Ignore reference in SPARK mode, as it refers to an entity not + -- in scope at the point of reference, so the reference should + -- be ignored for computing effects of subprograms. + and then not SPARK_Mode then Set_Entity (Selector_Name (Parent (A)), F);