From 7f54dc834806d508cef6a77a24d9308fd54cf196 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Tue, 27 Oct 2015 12:53:08 +0100 Subject: [PATCH] [multiple changes] 2015-10-27 Ed Schonberg * sem_ch4.adb (Analyze_Allocator): Do not perform legality check on allocators for limited objects in a qualified expression, because expression has not been resolved. * sem_res.adb (Resolve_Allocator): Perform check on legality of limited objects after resolution. Add sem_ch3.adb to context. 2015-10-27 Hristian Kirtchev * sem_prag.adb (Analyze_Refined_Global_In_Decl_Part): Add variable States. (Check_Refined_Global_Item): An object or state acts as a constituent only when the corresponding encapsulating state appears in pragma Global. (Collect_Global_Item): Add a state with non-null visible refinement to list States. 2015-10-27 Gary Dismukes * sem_util.ads, par.adb, sem_ch6.adb: Minor reformatting and a few typo corrections. 2015-10-27 Pierre-Marie de Rodat * namet.ads, namet.adb (Name_Equals): New function. * namet.h (Name_Equals): New macro. 2015-10-27 Arnaud Charlet * exp_ch6.adb (Build_Procedure_Form): Use 'RESULT' for the extra parameter, to avoid ambiguity when generating tmps using _xxx which might end up reusing _result. From-SVN: r229424 --- gcc/ada/ChangeLog | 34 ++++++++++++++++++++++++++++++++++ gcc/ada/exp_ch6.adb | 4 ++-- gcc/ada/namet.adb | 30 ++++++++++++++++++++++++++++++ gcc/ada/namet.ads | 3 +++ gcc/ada/namet.h | 5 ++++- gcc/ada/par.adb | 4 ++-- gcc/ada/sem_ch4.adb | 16 ---------------- gcc/ada/sem_ch6.adb | 4 ++-- gcc/ada/sem_prag.adb | 12 ++++++++++-- gcc/ada/sem_res.adb | 17 +++++++++++++++++ gcc/ada/sem_util.ads | 4 ++-- 11 files changed, 106 insertions(+), 27 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 59ed03f170f..1ec3066ceca 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,37 @@ +2015-10-27 Ed Schonberg + + * sem_ch4.adb (Analyze_Allocator): Do not perform legality check + on allocators for limited objects in a qualified expression, + because expression has not been resolved. + * sem_res.adb (Resolve_Allocator): Perform check on legality of + limited objects after resolution. Add sem_ch3.adb to context. + +2015-10-27 Hristian Kirtchev + + * sem_prag.adb (Analyze_Refined_Global_In_Decl_Part): Add variable + States. + (Check_Refined_Global_Item): An object or state acts as a + constituent only when the corresponding encapsulating state + appears in pragma Global. + (Collect_Global_Item): Add a state with non-null visible refinement to + list States. + +2015-10-27 Gary Dismukes + + * sem_util.ads, par.adb, sem_ch6.adb: Minor reformatting and a few + typo corrections. + +2015-10-27 Pierre-Marie de Rodat + + * namet.ads, namet.adb (Name_Equals): New function. + * namet.h (Name_Equals): New macro. + +2015-10-27 Arnaud Charlet + + * exp_ch6.adb (Build_Procedure_Form): Use 'RESULT' for the extra + parameter, to avoid ambiguity when generating tmps using _xxx which + might end up reusing _result. + 2015-10-27 Javier Miranda * sem_util.ads, sem_util.adb (Defining_Identifier): Adding a formal to diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index deaa8eab9d9..517143b9ea2 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -5516,8 +5516,8 @@ package body Exp_Ch6 is -- Add an extra out parameter to carry the function result - Name_Len := 7; - Name_Buffer (1 .. Name_Len) := "_result"; + Name_Len := 6; + Name_Buffer (1 .. Name_Len) := "RESULT"; Append_To (Proc_Formals, Make_Parameter_Specification (Loc, Defining_Identifier => diff --git a/gcc/ada/namet.adb b/gcc/ada/namet.adb index 6def9f273b7..cfaec6e545a 100644 --- a/gcc/ada/namet.adb +++ b/gcc/ada/namet.adb @@ -1639,6 +1639,36 @@ package body Namet is end if; end Write_Name_Decoded; + ----------------- + -- Name_Equals -- + ----------------- + + function Name_Equals (N1, N2 : Name_Id) return Boolean is + begin + if N1 = N2 then + return True; + end if; + + declare + L1 : constant Int := Int (Name_Entries.Table (N1).Name_Len); + L2 : constant Int := Int (Name_Entries.Table (N2).Name_Len); + begin + if L1 /= L2 then + return False; + end if; + + declare + use Name_Chars; + + I1 : constant Int := Name_Entries.Table (N1).Name_Chars_Index; + I2 : constant Int := Name_Entries.Table (N2).Name_Chars_Index; + begin + return (Name_Chars.Table (1 + I1 .. I1 + L1) + = Name_Chars.Table (1 + I2 .. I2 + L2)); + end; + end; + end Name_Equals; + -- Package initialization, initialize tables begin diff --git a/gcc/ada/namet.ads b/gcc/ada/namet.ads index 4a21ef5b87c..4a17e6eeee9 100644 --- a/gcc/ada/namet.ads +++ b/gcc/ada/namet.ads @@ -561,6 +561,9 @@ package Namet is -- described for Get_Decoded_Name_String, and the resulting value stored -- in Name_Len and Name_Buffer is the decoded name. + function Name_Equals (N1, N2 : Name_Id) return Boolean; + -- Return whether N1 and N2 denote the same character sequence + ------------------------------ -- File and Unit Name Types -- ------------------------------ diff --git a/gcc/ada/namet.h b/gcc/ada/namet.h index 1ca589ba50c..82af02d58fe 100644 --- a/gcc/ada/namet.h +++ b/gcc/ada/namet.h @@ -6,7 +6,7 @@ * * * C Header File * * * - * 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- * @@ -88,6 +88,9 @@ Get_Decoded_Name_String (Name_Id Id) return Name_Buffer; } +#define Name_Equals namet__name_equals +extern Boolean Name_Equals (Name_Id, Name_Id); + /* Like Get_Decoded_Name_String, but the result has all qualification and package body entity suffixes stripped, and also all letters are upper cased. This is used for building the enumeration literal table. */ diff --git a/gcc/ada/par.adb b/gcc/ada/par.adb index dc573876276..7c38084033f 100644 --- a/gcc/ada/par.adb +++ b/gcc/ada/par.adb @@ -1577,8 +1577,8 @@ begin -- versions of these files. Another exception is System.RPC -- and its children. This allows a user to supply their own -- communication layer. - -- Similarly we do not generate an error in CodePeer mode - -- to allow users to analyze third party compier packages. + -- Similarly, we do not generate an error in CodePeer mode, + -- to allow users to analyze third-party compiler packages. if Comp_Unit_Node /= Error and then Operating_Mode = Generate_Code diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index c354de8a498..394029cc87b 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -549,22 +549,6 @@ package body Sem_Ch4 is Type_Id := Etype (E); Set_Directly_Designated_Type (Acc_Type, Type_Id); - -- Allocators generated by the build-in-place expansion mechanism - -- are explicitly marked as coming from source but do not need to be - -- checked for limited initialization. To exclude this case, ensure - -- that the parent of the allocator is a source node. - - if Is_Limited_Type (Type_Id) - and then Comes_From_Source (N) - and then Comes_From_Source (Parent (N)) - and then not In_Instance_Body - then - if not OK_For_Limited_Init (Type_Id, Expression (E)) then - Error_Msg_N ("initialization not allowed for limited types", N); - Explain_Limited_Type (Type_Id, N); - end if; - end if; - -- A qualified expression requires an exact match of the type, -- class-wide matching is not allowed. diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 8a86d4465b7..e1fe3bb73b7 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -2383,7 +2383,7 @@ package body Sem_Ch6 is begin pragma Assert (Nkind (From) = N_Subprogram_Body); - -- The destination node must be part of a list as the pragmas are + -- The destination node must be part of a list, as the pragmas are -- inserted after it. pragma Assert (Is_List_Member (To)); @@ -3576,7 +3576,7 @@ package body Sem_Ch6 is -- Set the SPARK_Mode from the current context (may be overwritten later -- with explicit pragma). Exclude the case where the SPARK_Mode appears - -- initially on a stand alone subprogram body, but is then relocated to + -- initially on a stand-alone subprogram body, but is then relocated to -- a generated corresponding spec. In this scenario the mode is shared -- between the spec and body. diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 8ac388e237f..0e4d30d2509 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -527,7 +527,7 @@ package body Sem_Prag is -- E_Constant - "constant" -- E_Discriminant - "discriminant" -- E_Generic_In_Out_Parameter - "generic parameter" - -- E_Generic_Out_Parameter - "generic parameter" + -- E_Generic_In_Parameter - "generic parameter" -- E_In_Parameter - "parameter" -- E_In_Out_Parameter - "parameter" -- E_Loop_Parameter - "loop parameter" @@ -24057,6 +24057,9 @@ package body Sem_Prag is Spec_Id : Entity_Id; -- The entity of the subprogram subject to pragma Refined_Global + States : Elist_Id := No_Elist; + -- A list of all states with visible refinement found in pragma Global + procedure Check_In_Out_States; -- Determine whether the corresponding Global pragma mentions In_Out -- states with visible refinement and if so, ensure that one of the @@ -24566,11 +24569,14 @@ package body Sem_Prag is begin -- When the state or object acts as a constituent of another -- state with a visible refinement, collect it for the state - -- completeness checks performed later on. + -- completeness checks performed later on. Note that the item + -- acts as a constituent only when the encapsulating state is + -- present in pragma Global. if Ekind_In (Item_Id, E_Abstract_State, E_Constant, E_Variable) and then Present (Encapsulating_State (Item_Id)) and then Has_Visible_Refinement (Encapsulating_State (Item_Id)) + and then Contains (States, Encapsulating_State (Item_Id)) then if Global_Mode = Name_Input then Append_New_Elmt (Item_Id, In_Constits); @@ -24715,6 +24721,8 @@ package body Sem_Prag is Has_Null_State := True; elsif Has_Non_Null_Refinement (Item_Id) then + Append_New_Elmt (Item_Id, States); + if Item_Mode = Name_Input then Has_In_State := True; elsif Item_Mode = Name_In_Out then diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index b82fd6f4adb..5ee73a938df 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -57,6 +57,7 @@ with Sem_Aggr; use Sem_Aggr; with Sem_Attr; use Sem_Attr; with Sem_Cat; use Sem_Cat; with Sem_Ch4; use Sem_Ch4; +with Sem_Ch3; use Sem_Ch3; with Sem_Ch6; use Sem_Ch6; with Sem_Ch8; use Sem_Ch8; with Sem_Ch13; use Sem_Ch13; @@ -4680,6 +4681,22 @@ package body Sem_Res is Check_Non_Static_Context (Expression (E)); Check_Unset_Reference (Expression (E)); + -- Allocators generated by the build-in-place expansion mechanism + -- are explicitly marked as coming from source but do not need to be + -- checked for limited initialization. To exclude this case, ensure + -- that the parent of the allocator is a source node. + + if Is_Limited_Type (Etype (E)) + and then Comes_From_Source (N) + and then Comes_From_Source (Parent (N)) + and then not In_Instance_Body + then + if not OK_For_Limited_Init (Etype (E), Expression (E)) then + Error_Msg_N ("initialization not allowed for limited types", N); + Explain_Limited_Type (Etype (E), N); + end if; + end if; + -- A qualified expression requires an exact match of the type. -- Class-wide matching is not allowed. diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 411798ed06a..0f6dd7ceaa4 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -480,8 +480,8 @@ package Sem_Util is -- internally generated entity which is subsequently returned. A node -- that does not allow for a defining entity raises Program_Error. -- - -- The former semantic is appropriate for the backend; the latter semantic - -- is appropriate for the frontend. + -- The former semantics is appropriate for the back end; the latter + -- semantics is appropriate for the front end. function Denotes_Discriminant (N : Node_Id; -- 2.30.2