aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorArnaud Charlet <charlet@gcc.gnu.org>2015-01-30 16:15:45 +0100
committerArnaud Charlet <charlet@gcc.gnu.org>2015-01-30 16:15:45 +0100
commit1db700c32b598f2b8cead592036713cbc69c8058 (patch)
treeaf36e6aacec112b58a5f83a33f916f37537a549e
parent1de83011b142444b5b35e699799c2e7b1485b8e6 (diff)
downloadgcc-1db700c32b598f2b8cead592036713cbc69c8058.zip
gcc-1db700c32b598f2b8cead592036713cbc69c8058.tar.gz
gcc-1db700c32b598f2b8cead592036713cbc69c8058.tar.bz2
[multiple changes]
2015-01-30 Gary Dismukes <dismukes@adacore.com> * errout.ads: Minor reformatting. 2015-01-30 Yannick Moy <moy@adacore.com> * inline.adb (Process_Formals): Use the sloc of the inlined node instead of the sloc of the actual parameter, when replacing formal parameters by the actual one. 2015-01-30 Arnaud Charlet <charlet@adacore.com> * g-expect.adb (Get_Command_Output): Use infinite timeout when calling Expect. 2015-01-30 Ed Schonberg <schonberg@adacore.com> * sem_ch12.adb (Analyze_Associations): If an in-parameter is defaulted in an instantiation, add an entry in the list of actuals to indicate the default value of the formal (as is already done for defaulted subprograms). 2015-01-30 Javier Miranda <miranda@adacore.com> * errout.adb (Error_Msg_PT): Minor error phrasing update. 2015-01-30 Robert Dewar <dewar@adacore.com> * sem_warn.adb (Warn_On_Known_Condition): Improve error message for object case. 2015-01-30 Pierre-Marie de Rodat <derodat@adacore.com> * exp_dbug.adb (Get_Encoded_Name): When -fgnat-encodings=minimal, do not generate names for biased types. From-SVN: r220286
-rw-r--r--gcc/ada/ChangeLog36
-rw-r--r--gcc/ada/errout.adb3
-rw-r--r--gcc/ada/errout.ads2
-rw-r--r--gcc/ada/exp_dbug.adb15
-rw-r--r--gcc/ada/g-expect.adb4
-rw-r--r--gcc/ada/inline.adb6
-rw-r--r--gcc/ada/sem_ch12.adb100
-rw-r--r--gcc/ada/sem_warn.adb4
8 files changed, 112 insertions, 58 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 2f1b532..8829a1f 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,39 @@
+2015-01-30 Gary Dismukes <dismukes@adacore.com>
+
+ * errout.ads: Minor reformatting.
+
+2015-01-30 Yannick Moy <moy@adacore.com>
+
+ * inline.adb (Process_Formals): Use the sloc of
+ the inlined node instead of the sloc of the actual parameter,
+ when replacing formal parameters by the actual one.
+
+2015-01-30 Arnaud Charlet <charlet@adacore.com>
+
+ * g-expect.adb (Get_Command_Output): Use infinite timeout when
+ calling Expect.
+
+2015-01-30 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch12.adb (Analyze_Associations): If an in-parameter is
+ defaulted in an instantiation, add an entry in the list of actuals
+ to indicate the default value of the formal (as is already done
+ for defaulted subprograms).
+
+2015-01-30 Javier Miranda <miranda@adacore.com>
+
+ * errout.adb (Error_Msg_PT): Minor error phrasing update.
+
+2015-01-30 Robert Dewar <dewar@adacore.com>
+
+ * sem_warn.adb (Warn_On_Known_Condition): Improve error message
+ for object case.
+
+2015-01-30 Pierre-Marie de Rodat <derodat@adacore.com>
+
+ * exp_dbug.adb (Get_Encoded_Name): When
+ -fgnat-encodings=minimal, do not generate names for biased types.
+
2015-01-30 Tristan Gingold <gingold@adacore.com>
PR ada/64349
diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb
index d04d132..e48956b 100644
--- a/gcc/ada/errout.adb
+++ b/gcc/ada/errout.adb
@@ -687,7 +687,8 @@ package body Errout is
Error_Msg_Sloc := Sloc (Iface_Prim);
Error_Msg_N
- ("\first formal of & declared # has wrong mode (RM 9.4(11.9))", E);
+ ("\first formal of & declared # must be of mode `OUT`, `IN OUT` " &
+ "or access-to-variable", E);
end Error_Msg_PT;
-----------------
diff --git a/gcc/ada/errout.ads b/gcc/ada/errout.ads
index 6105880..d189240 100644
--- a/gcc/ada/errout.ads
+++ b/gcc/ada/errout.ads
@@ -851,7 +851,7 @@ package Errout is
procedure Error_Msg_PT (E : Entity_Id; Iface_Prim : Entity_Id);
-- Posts an error on protected type entry or subprogram E (referencing its
-- overridden interface primitive Iface_Prim) indicating wrong mode of the
- -- first formal (RM 9.4(11.9/3))
+ -- first formal (RM 9.4(11.9/3)).
procedure Error_Msg_Ada_2012_Feature (Feature : String; Loc : Source_Ptr);
-- If not operating in Ada 2012 mode, posts errors complaining that Feature
diff --git a/gcc/ada/exp_dbug.adb b/gcc/ada/exp_dbug.adb
index 3ed470a..1a05adb 100644
--- a/gcc/ada/exp_dbug.adb
+++ b/gcc/ada/exp_dbug.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1996-2014, Free Software Foundation, Inc. --
+-- Copyright (C) 1996-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- --
@@ -634,15 +634,12 @@ package body Exp_Dbug is
Add_Real_To_Buffer (Small_Value (E));
end if;
- -- Discrete case where bounds do not match size. Match only biased
- -- types when asked to output as little encodings as possible.
+ -- Discrete case where bounds do not match size. Not necessary if we can
+ -- emit standard DWARF.
- elsif ((GNAT_Encodings /= DWARF_GNAT_Encodings_Minimal
- and then Is_Discrete_Type (E))
- or else
- (GNAT_Encodings = DWARF_GNAT_Encodings_Minimal
- and then Has_Biased_Representation (E)))
- and then not Bounds_Match_Size (E)
+ elsif GNAT_Encodings /= DWARF_GNAT_Encodings_Minimal
+ and then Is_Discrete_Type (E)
+ and then not Bounds_Match_Size (E)
then
declare
Lo : constant Node_Id := Type_Low_Bound (E);
diff --git a/gcc/ada/g-expect.adb b/gcc/ada/g-expect.adb
index 94f80e9..831d823 100644
--- a/gcc/ada/g-expect.adb
+++ b/gcc/ada/g-expect.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 2000-2014, AdaCore --
+-- Copyright (C) 2000-2015, AdaCore --
-- --
-- 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- --
@@ -927,7 +927,7 @@ package body GNAT.Expect is
-- This loop runs until the call to Expect raises Process_Died
loop
- Expect (Process, Result, ".+");
+ Expect (Process, Result, ".+", Timeout => -1);
declare
NOutput : String_Access;
diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb
index 438be77..896a5e4 100644
--- a/gcc/ada/inline.adb
+++ b/gcc/ada/inline.adb
@@ -6,7 +6,7 @@
-- --
-- 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- --
@@ -2248,11 +2248,11 @@ package body Inline is
-- analyzed with the full view).
if Is_Entity_Name (A) then
- Rewrite (N, New_Occurrence_Of (Entity (A), Loc));
+ Rewrite (N, New_Occurrence_Of (Entity (A), Sloc (N)));
Check_Private_View (N);
elsif Nkind (A) = N_Defining_Identifier then
- Rewrite (N, New_Occurrence_Of (A, Loc));
+ Rewrite (N, New_Occurrence_Of (A, Sloc (N)));
Check_Private_View (N);
-- Numeric literal
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index b7e9343..0d698cf 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -6,7 +6,7 @@
-- --
-- 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- --
@@ -921,7 +921,7 @@ package body Sem_Ch12 is
is
Actuals_To_Freeze : constant Elist_Id := New_Elmt_List;
Assoc : constant List_Id := New_List;
- Default_Actuals : constant Elist_Id := New_Elmt_List;
+ Default_Actuals : constant List_Id := New_List;
Gen_Unit : constant Entity_Id :=
Defining_Entity (Parent (F_Copy));
@@ -1385,16 +1385,34 @@ package body Sem_Ch12 is
case Nkind (Formal) is
when N_Formal_Object_Declaration =>
Match :=
- Matching_Actual (
- Defining_Identifier (Formal),
- Defining_Identifier (Analyzed_Formal));
+ Matching_Actual
+ (Defining_Identifier (Formal),
+ Defining_Identifier (Analyzed_Formal));
if No (Match) and then Partial_Parameterization then
Process_Default (Formal);
+
else
Append_List
(Instantiate_Object (Formal, Match, Analyzed_Formal),
Assoc);
+
+ -- For a defaulted in_parameter, create an entry in the
+ -- the list of defaulted actuals, for GNATProve use. Do
+ -- not included these defaults for an instance nested
+ -- within a generic, because the defaults are also used
+ -- in the analysis of the enclosing generic, and only
+ -- defaulted subprograms are relevant there.
+
+ if No (Match) and then not Inside_A_Generic then
+ Append_To (Default_Actuals,
+ Make_Generic_Association (Sloc (I_Node),
+ Selector_Name =>
+ New_Occurrence_Of
+ (Defining_Identifier (Formal), Sloc (I_Node)),
+ Explicit_Generic_Actual_Parameter =>
+ New_Copy_Tree (Default_Expression (Formal))));
+ end if;
end if;
-- If the object is a call to an expression function, this
@@ -1404,16 +1422,16 @@ package body Sem_Ch12 is
and then Present (Entity (Match))
and then Nkind
(Original_Node (Unit_Declaration_Node (Entity (Match))))
- = N_Expression_Function
+ = N_Expression_Function
then
Append_Elmt (Entity (Match), Actuals_To_Freeze);
end if;
when N_Formal_Type_Declaration =>
Match :=
- Matching_Actual (
- Defining_Identifier (Formal),
- Defining_Identifier (Analyzed_Formal));
+ Matching_Actual
+ (Defining_Identifier (Formal),
+ Defining_Identifier (Analyzed_Formal));
if No (Match) then
if Partial_Parameterization then
@@ -1474,10 +1492,10 @@ package body Sem_Ch12 is
then
declare
Formal_Ent : constant Entity_Id :=
- Defining_Identifier (Analyzed_Formal);
+ Defining_Identifier (Analyzed_Formal);
begin
if Is_Remote_Access_To_Class_Wide_Type (Entity (Match))
- = Is_Remote_Types (Formal_Ent)
+ = Is_Remote_Types (Formal_Ent)
then
-- Remoteness of formal and actual match
@@ -1567,12 +1585,22 @@ package body Sem_Ch12 is
end if;
-- If this is a nested generic, preserve default for later
- -- instantiations.
+ -- instantiations. We do this as well for GNATProve use,
+ -- so that the list of generic associations is complete.
if No (Match) and then Box_Present (Formal) then
- Append_Elmt
- (Defining_Unit_Name (Specification (Last (Assoc))),
- Default_Actuals);
+ declare
+ Subp : constant Entity_Id :=
+ Defining_Unit_Name (Specification (Last (Assoc)));
+
+ begin
+ Append_To (Default_Actuals,
+ Make_Generic_Association (Sloc (I_Node),
+ Selector_Name =>
+ New_Occurrence_Of (Subp, Sloc (I_Node)),
+ Explicit_Generic_Actual_Parameter =>
+ New_Occurrence_Of (Subp, Sloc (I_Node))));
+ end;
end if;
when N_Formal_Package_Declaration =>
@@ -1667,31 +1695,24 @@ package body Sem_Ch12 is
-- explicit associations for them. This is required if the instance
-- appears within a generic.
- declare
- Elmt : Elmt_Id;
- Subp : Entity_Id;
- New_D : Node_Id;
+ if not Is_Empty_List (Default_Actuals) then
+ declare
+ Default : Node_Id;
+
+ begin
+ Default := First (Default_Actuals);
+ while Present (Default) loop
+ Mark_Rewrite_Insertion (Default);
+ Next (Default);
+ end loop;
- begin
- Elmt := First_Elmt (Default_Actuals);
- while Present (Elmt) loop
if No (Actuals) then
- Actuals := New_List;
- Set_Generic_Associations (I_Node, Actuals);
- end if;
-
- Subp := Node (Elmt);
- New_D :=
- Make_Generic_Association (Sloc (Subp),
- Selector_Name =>
- New_Occurrence_Of (Subp, Sloc (Subp)),
- Explicit_Generic_Actual_Parameter =>
- New_Occurrence_Of (Subp, Sloc (Subp)));
- Mark_Rewrite_Insertion (New_D);
- Append_To (Actuals, New_D);
- Next_Elmt (Elmt);
- end loop;
- end;
+ Set_Generic_Associations (I_Node, Default_Actuals);
+ else
+ Append_List_To (Actuals, Default_Actuals);
+ end if;
+ end;
+ end if;
-- If this is a formal package, normalize the parameter list by adding
-- explicit box associations for the formals that are covered by an
@@ -9455,8 +9476,7 @@ package body Sem_Ch12 is
if Present (Formal_Ent) then
Find_Matching_Actual (Formal_Node, Actual_Ent);
- Match_Formal_Entity
- (Formal_Node, Formal_Ent, Actual_Ent);
+ Match_Formal_Entity (Formal_Node, Formal_Ent, Actual_Ent);
-- We iterate at the same time over the actuals of the
-- local package created for the formal, to determine
diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb
index 355599b..5634427 100644
--- a/gcc/ada/sem_warn.adb
+++ b/gcc/ada/sem_warn.adb
@@ -3404,7 +3404,7 @@ package body Sem_Warn is
and then Nkind (Cond) /= N_Op_Not
then
Error_Msg_NE
- ("object & is always True?c?",
+ ("object & is always True at this point?c?",
Cond, Original_Node (C));
Track (Original_Node (C), Cond);
@@ -3420,7 +3420,7 @@ package body Sem_Warn is
and then Nkind (Cond) /= N_Op_Not
then
Error_Msg_NE
- ("object & is always False?c?",
+ ("object & is always False at this point?c?",
Cond, Original_Node (C));
Track (Original_Node (C), Cond);