+2015-02-20 Robert Dewar <dewar@adacore.com>
+
+ * errout.ads: Document replacement of Name_uPre/Post/Type_Invariant.
+ * erroutc.adb (Set_Msg_Str): Replace _xxx.
+ (Pre/Post/Type_Invariant) by xxx'Class.
+ * erroutc.ads (Set_Msg_Str): Replace _xxx.
+ (Pre/Post/Type_Invariant) by xxx'Class.
+ * sem_prag.adb (Fix_Error): Remove special casing of
+ Name_uType_Invariant.
+ (Analyze_Pre_Post_Condition_In_Decl_Part): Remove special casing of
+ Name_uPre and Name_uPost in aspect case (done in Errout now).
+
+2015-02-20 Robert Dewar <dewar@adacore.com>
+
+ * g-alveop.adb: Minor style fixes.
+
+2015-02-20 Robert Dewar <dewar@adacore.com>
+
+ * freeze.adb (Warn_Overlay): Guard against blow up with address
+ clause.
+
+2015-02-20 Bob Duff <duff@adacore.com>
+
+ * exp_attr.adb (May_Be_External_Call): Remove this. There is no need
+ for the compiler to guess whether the call is internal or external --
+ it is always external.
+ (Expand_Access_To_Protected_Op): For P'Access, where P
+ is a protected subprogram, always create a pointer to the
+ External_Subprogram.
+
2015-02-20 Robert Dewar <dewar@adacore.com>
* a-dispat.adb, a-stcoed.ads: Minor reformatting.
-- casing mode. Note: if a unit name ending with %b or %s is passed
-- for this kind of insertion, this suffix is simply stripped. Use a
-- unit name insertion ($) to process the suffix.
+ --
+ -- Note: the special names _xxx (xxx = Pre/Post/Invariant) are changed
+ -- to insert the string xxx'Class into the message.
-- Insertion character %% (Double percent: insert literal name)
-- The character sequence %% acts as described above for %, except
-- that the name is simply obtained with Get_Name_String and is not
-- decoded or cased, it is inserted literally from the names table.
-- A trailing %b or %s is not treated specially.
+ --
+ -- Note: the special names _xxx (xxx = Pre/Post/Invariant) are changed
+ -- to insert the string xxx'Class into the message.
-- Insertion character $ (Dollar: insert unit name from Names table)
-- The character $ is treated similarly to %, except that the name is
-- Error_Msg_Qual_Level is non-zero, then the reference will include
-- up to the given number of levels of qualification, using the scope
-- chain.
+ --
+ -- Note: the special names _xxx (xxx = Pre/Post/Invariant) are changed
+ -- to insert the string xxx'Class into the message.
-- Insertion character # (Pound: insert line number reference)
-- The character # is replaced by the string indicating the source
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2015, 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- --
procedure Set_Msg_Name_Buffer is
begin
- for J in 1 .. Name_Len loop
- Set_Msg_Char (Name_Buffer (J));
- end loop;
+ Set_Msg_Str (Name_Buffer (1 .. Name_Len));
end Set_Msg_Name_Buffer;
-------------------
procedure Set_Msg_Str (Text : String) is
begin
- for J in Text'Range loop
- Set_Msg_Char (Text (J));
- end loop;
+ -- Do replacement for special x'Class aspect names
+
+ if Text = "_Pre" then
+ Set_Msg_Str ("Pre'Class");
+
+ elsif Text = "_Post" then
+ Set_Msg_Str ("Post'Class");
+
+ elsif Text = "_Type_Invariant" then
+ Set_Msg_Str ("Type_Invariant'Class");
+
+ elsif Text = "_pre" then
+ Set_Msg_Str ("pre'class");
+
+ elsif Text = "_post" then
+ Set_Msg_Str ("post'class");
+
+ elsif Text = "_type_invariant" then
+ Set_Msg_Str ("type_invariant'class");
+
+ elsif Text = "_PRE" then
+ Set_Msg_Str ("PRE'CLASS");
+
+ elsif Text = "_POST" then
+ Set_Msg_Str ("POST'CLASS");
+
+ elsif Text = "_TYPE_INVARIANT" then
+ Set_Msg_Str ("TYPE_INVARIANT'CLASS");
+
+ -- Normal case with no replacement
+
+ else
+ for J in Text'Range loop
+ Set_Msg_Char (Text (J));
+ end loop;
+ end if;
end Set_Msg_Str;
------------------------------
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2015, 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- --
procedure Set_Msg_Str (Text : String);
-- Add a sequence of characters to the current message. This routine does
-- not check for special insertion characters (they are just treated as
- -- text characters if they occur).
+ -- text characters if they occur). It does perform the transformation of
+ -- the special strings _xxx (xxx = Pre/Post/Type_Invariant) to xxx'Class.
procedure Set_Next_Non_Deleted_Msg (E : in out Error_Msg_Id);
-- Given a message id, move to next message id, but skip any deleted
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2015, 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- --
Obj_Ref : Node_Id;
Curr : Entity_Id;
- function May_Be_External_Call return Boolean;
- -- If the 'Access is to a local operation, but appears in a context
- -- where it may lead to a call from outside the object, we must treat
- -- this as an external call. Clearly we cannot tell without full
- -- flow analysis, and a subsequent call that uses this 'Access may
- -- lead to a bounded error (trying to seize locks twice, e.g.). For
- -- now we treat 'Access as a potential external call if it is an actual
- -- in a call to an outside subprogram.
-
- --------------------------
- -- May_Be_External_Call --
- --------------------------
-
- function May_Be_External_Call return Boolean is
- Subp : Entity_Id;
- Par : Node_Id := Parent (N);
-
- begin
- -- Account for the case where the Access attribute is part of a
- -- named parameter association.
-
- if Nkind (Par) = N_Parameter_Association then
- Par := Parent (Par);
- end if;
-
- if Nkind (Par) in N_Subprogram_Call
- and then Is_Entity_Name (Name (Par))
- then
- Subp := Entity (Name (Par));
- return not In_Open_Scopes (Scope (Subp));
- else
- return False;
- end if;
- end May_Be_External_Call;
-
-- Start of processing for Expand_Access_To_Protected_Op
begin
-- protected body of the current enclosing operation.
if Is_Entity_Name (Pref) then
- if May_Be_External_Call then
- Sub :=
- New_Occurrence_Of (External_Subprogram (Entity (Pref)), Loc);
- else
- Sub :=
- New_Occurrence_Of
- (Protected_Body_Subprogram (Entity (Pref)), Loc);
- end if;
+ -- All indirect calls are external calls, so must do locking and
+ -- barrier reevaluation, even if the 'Access occurs within the
+ -- protected body. Hence the call to External_Subprogram, as opposed
+ -- to Protected_Body_Subprogram, below. See RM-9.5(5). This means
+ -- that indirect calls from within the same protected body will
+ -- deadlock, as allowed by RM-9.5.1(8,15,17).
+
+ Sub := New_Occurrence_Of (External_Subprogram (Entity (Pref)), Loc);
-- Don't traverse the scopes when the attribute occurs within an init
-- proc, because we directly use the _init formal of the init proc in
return;
end if;
- Decl := Next (Parent (Expr));
-
-- If a pragma Import follows, we assume that it is for the current
-- target of the address clause, and skip the warning.
- if Present (Decl)
- and then Nkind (Decl) = N_Pragma
- and then Pragma_Name (Decl) = Name_Import
- then
- return;
+ if Is_List_Member (Parent (Expr)) then
+ Decl := Next (Parent (Expr));
+
+ if Present (Decl)
+ and then Nkind (Decl) = N_Pragma
+ and then Pragma_Name (Decl) = Name_Import
+ then
+ return;
+ end if;
end if;
+ -- Otherwise give warning message
+
if Present (Old) then
Error_Msg_Node_2 := Old;
Error_Msg_N
with GNAT.Altivec.Low_Level_Interface; use GNAT.Altivec.Low_Level_Interface;
-------------------------------------
--- GNAT.Altivec.Vector_Operations --
-------------------------------------
-
-------------------------------------
--- GNAT.Altivec.Vector_Operations --
-------------------------------------
-
package body GNAT.Altivec.Vector_Operations is
--------------------------------------------------------
-- Get name from corresponding aspect
Error_Msg_Name_1 := Original_Aspect_Name (N);
-
- if Class_Present (N) then
-
- -- Replace the name with a leading underscore used
- -- internally, with a name that is more user-friendly.
-
- if Error_Msg_Name_1 = Name_uType_Invariant then
- Error_Msg_Name_1 := Name_Type_Invariant_Class;
- end if;
- end if;
-
end if;
-- Return possibly modified message
-- Pre'Class/Post'Class aspect cases
if From_Aspect_Specification (Prag) then
- if Nam = Name_uPre then
- Error_Msg_Name_1 := Name_Pre;
- else
- Error_Msg_Name_1 := Name_Post;
- end if;
-
- Error_Msg_Name_2 := Name_Class;
-
+ Error_Msg_Name_1 := Nam;
Error_Msg_N
- ("aspect `%''%` can only be specified for a primitive "
+ ("aspect% can only be specified for a primitive "
& "operation of a tagged type",
Corresponding_Aspect (Prag));
projects / gcc.git / commitdiff