+2015-10-27 Ed Schonberg <schonberg@adacore.com>
+
+ * 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 <kirtchev@adacore.com>
+
+ * 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 <dismukes@adacore.com>
+
+ * sem_util.ads, par.adb, sem_ch6.adb: Minor reformatting and a few
+ typo corrections.
+
+2015-10-27 Pierre-Marie de Rodat <derodat@adacore.com>
+
+ * namet.ads, namet.adb (Name_Equals): New function.
+ * namet.h (Name_Equals): New macro.
+
+2015-10-27 Arnaud Charlet <charlet@adacore.com>
+
+ * 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 <miranda@adacore.com>
* sem_util.ads, sem_util.adb (Defining_Identifier): Adding a formal to
-- 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 =>
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
-- 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 --
------------------------------
* *
* 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- *
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. */
-- 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
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.
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));
-- 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.
-- 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"
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
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);
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
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;
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.
-- 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;
projects / gcc.git / commitdiff