+2017-01-20 Thomas Quinot <quinot@adacore.com>
+
+ * sem_warn.adb (Warn_On_Useless_Assignment): Adjust wording of warning
+ message.
+
+2017-01-20 Nicolas Roche <roche@adacore.com>
+
+ * terminals.c: Ignore failures on setpgid and tcsetpgrp commands.
+
+2017-01-20 Bob Duff <duff@adacore.com>
+
+ * sem_eval.adb (Compile_Time_Compare): Disable the expr+literal
+ (etc) optimizations when the type is modular.
+
+2017-01-20 Yannick Moy <moy@adacore.com>
+
+ * sem_ch6.adb (Move_Pragmas): move some pragmas,
+ but copy the SPARK_Mode pragma instead of moving it.
+ (Build_Subprogram_Declaration): Ensure that the generated spec
+ and original body share the same SPARK_Pragma aspect/pragma.
+ * sem_util.adb, sem_util.ads (Copy_SPARK_Mode_Aspect): New
+ procedure to copy SPARK_Mode aspect.
+
+2017-01-20 Bob Duff <duff@adacore.com>
+
+ * sem_ch3.adb (Analyze_Declarations): Disable Resolve_Aspects
+ even in ASIS mode.
+ * sem_ch13.adb (Resolve_Name): Enable setting the entity to
+ Empty even in ASIS mode.
+
2017-01-20 Hristian Kirtchev <kirtchev@adacore.com>
* exp_ch9.adb: minor style fixes in comments.
elsif Nkind (N) = N_Identifier and then Chars (N) /= Chars (E) then
Find_Direct_Name (N);
- if not ASIS_Mode then
+ if True or else not ASIS_Mode then -- ????
Set_Entity (N, Empty);
end if;
-- rejected. Pending notification we restrict this call to
-- ASIS mode.
- if ASIS_Mode then
+ if False and then ASIS_Mode then -- ????
Resolve_Aspects;
end if;
-- of subprogram body From and insert them after node To. The pragmas
-- in question are:
-- Ghost
- -- SPARK_Mode
-- Volatile_Function
+ -- Also copy pragma SPARK_Mode if present in the declarative list
+ -- of subprogram body From and insert it after node To. This pragma
+ -- should not be moved, as it applies to the body too.
------------------
-- Move_Pragmas --
while Present (Decl) loop
Next_Decl := Next (Decl);
- if Nkind (Decl) = N_Pragma
- and then Nam_In (Pragma_Name_Unmapped (Decl),
- Name_Ghost,
- Name_SPARK_Mode,
- Name_Volatile_Function)
- then
- Remove (Decl);
- Insert_After (To, Decl);
+ if Nkind (Decl) = N_Pragma then
+ if Pragma_Name_Unmapped (Decl) = Name_SPARK_Mode then
+ Insert_After (To, New_Copy_Tree (Decl));
+
+ elsif Nam_In (Pragma_Name_Unmapped (Decl),
+ Name_Ghost,
+ Name_Volatile_Function)
+ then
+ Remove (Decl);
+ Insert_After (To, Decl);
+ end if;
end if;
Decl := Next_Decl;
Move_Aspects (N, To => Subp_Decl);
Move_Pragmas (N, To => Subp_Decl);
+ -- Ensure that the generated corresponding spec and original body
+ -- share the same SPARK_Mode pragma or aspect. As a result, both have
+ -- the same SPARK_Mode attributes, and the global SPARK_Mode value is
+ -- correctly set for local subprograms.
+
+ Copy_SPARK_Mode_Aspect (Subp_Decl, To => N);
+
Analyze (Subp_Decl);
-- Propagate the attributes Rewritten_For_C and Corresponding_Proc to
Body_Spec := Copy_Subprogram_Spec (Body_Spec);
Set_Specification (N, Body_Spec);
Body_Id := Analyze_Subprogram_Specification (Body_Spec);
-
- -- Ensure that the generated corresponding spec and original body
- -- share the same SPARK_Mode attributes.
-
- Set_SPARK_Pragma (Body_Id, SPARK_Pragma (Spec_Id));
- Set_SPARK_Pragma_Inherited
- (Body_Id, SPARK_Pragma_Inherited (Spec_Id));
end Build_Subprogram_Declaration;
----------------------------
return Unknown;
end if;
- -- We do not attempt comparisons for packed arrays arrays represented as
+ -- We do not attempt comparisons for packed arrays represented as
-- modular types, where the semantics of comparison is quite different.
if Is_Packed_Array_Impl_Type (Ltyp)
-- J .. J + 1. This code can conclude LT with a difference of 1,
-- even if the range of J is not known.
- declare
- Lnode : Node_Id;
- Loffs : Uint;
- Rnode : Node_Id;
- Roffs : Uint;
+ -- This would be wrong for modular types (e.g. X < X + 1 is False if
+ -- X is the largest number).
- begin
- Compare_Decompose (L, Lnode, Loffs);
- Compare_Decompose (R, Rnode, Roffs);
+ if not Is_Modular_Integer_Type (Ltyp)
+ and then not Is_Modular_Integer_Type (Rtyp)
+ then
+ declare
+ Lnode : Node_Id;
+ Loffs : Uint;
+ Rnode : Node_Id;
+ Roffs : Uint;
- if Is_Same_Value (Lnode, Rnode) then
- if Loffs = Roffs then
- return EQ;
- elsif Loffs < Roffs then
- Diff.all := Roffs - Loffs;
- return LT;
- else
- Diff.all := Loffs - Roffs;
- return GT;
+ begin
+ Compare_Decompose (L, Lnode, Loffs);
+ Compare_Decompose (R, Rnode, Roffs);
+
+ if Is_Same_Value (Lnode, Rnode) then
+ if Loffs = Roffs then
+ return EQ;
+ elsif Loffs < Roffs then
+ Diff.all := Roffs - Loffs;
+ return LT;
+ else
+ Diff.all := Loffs - Roffs;
+ return GT;
+ end if;
end if;
- end if;
- end;
+ end;
+ end if;
-- Next, try range analysis and see if operand ranges are disjoint
return Plist;
end Copy_Parameter_List;
+ ----------------------------
+ -- Copy_SPARK_Mode_Aspect --
+ ----------------------------
+
+ procedure Copy_SPARK_Mode_Aspect (From : Node_Id; To : Node_Id) is
+ pragma Assert (not Has_Aspects (To));
+ Asp : Node_Id;
+ begin
+ if Has_Aspects (From) then
+ Asp := Find_Aspect (Defining_Entity (From), Aspect_SPARK_Mode);
+
+ if Present (Asp) then
+ Set_Aspect_Specifications (To, New_List (New_Copy_Tree (Asp)));
+ Set_Has_Aspects (To, True);
+ end if;
+ end if;
+ end Copy_SPARK_Mode_Aspect;
+
--------------------------
-- Copy_Subprogram_Spec --
--------------------------
-- of inlining, and for private protected ops. Also used to create bodies
-- for stubbed subprograms.
+ procedure Copy_SPARK_Mode_Aspect (From : Node_Id; To : Node_Id);
+ -- Copy the SPARK_Mode aspect if present in the aspect specifications
+ -- of node From to node To. On entry it is assumed that To does not have
+ -- aspect specifications. If From has no aspects, the routine has no
+ -- effect.
+
function Copy_Subprogram_Spec (Spec : Node_Id) return Node_Id;
-- Replicate a function or a procedure specification denoted by Spec. The
-- resulting tree is an exact duplicate of the original tree. New entities
begin
-- Don't give this for OUT and IN OUT formals, since
-- clearly caller may reference the assigned value. Also
- -- never give such warnings for internal variables.
+ -- never give such warnings for internal variables. In
+ -- either case, word the warning in a conditional way,
+ -- because in the case of a component of a controlled
+ -- type, the assigned value might be referenced in the
+ -- Finalize operation, so we can't make a definitive
+ -- statement that it's never referenced.
if Ekind (Ent) = E_Variable
and then not Is_Internal_Name (Chars (Ent))
N_Parameter_Association)
then
Error_Msg_NE
- ("?m?& modified by call, but value never "
- & "referenced", LA, Ent);
+ ("?m?& modified by call, but value might not "
+ & "be referenced", LA, Ent);
else
Error_Msg_NE -- CODEFIX
- ("?m?useless assignment to&, value never "
- & "referenced!", LA, Ent);
+ ("?m?possibly useless assignment to&, value "
+ & "might not be referenced!", LA, Ent);
end if;
end if;
end;
if (desc->slave_fd > 2) close (desc->slave_fd);
/* adjust process group settings */
- if ((status = setpgid (pid, pid)) == -1)
- return -1;
- if ((status = tcsetpgrp (0, pid)) == -1)
- return -1;
+ /* ignore failures of the following two commands as the context might not
+ * allow making those changes. */
+ setpgid (pid, pid);
+ tcsetpgrp (0, pid);
/* launch the program */
execvp (new_argv[0], new_argv);
projects / gcc.git / commitdiff