+2015-01-07 Tristan Gingold <gingold@adacore.com>
+
+ * i-cpoint.adb (Copy_Terminated_Array): Use Copy_Array to
+ handle overlap.
+
+2015-01-07 Eric Botcazou <ebotcazou@adacore.com>
+
+ * sem_ch3.adb (Analyze_Full_Type_Declaration): Do not
+ automatically set No_Strict_Aliasing on access types.
+ * fe.h (No_Strict_Aliasing_CP): Declare.
+ * gcc-interface/trans.c (gigi): Force flag_strict_aliasing to 0 if
+ No_Strict_Aliasing_CP is set.
+
+2015-01-07 Johannes Kanig <kanig@adacore.com>
+
+ * sem_ch8.adb (Analyze_Subprogram_Renaming) do
+ not build function wrapper in gnatprove mode when the package
+ is externally axiomatized.
+
+2015-01-07 Jose Ruiz <ruiz@adacore.com>
+
+ * a-reatim.adb (Time_Of): Reduce the number of spurious overflows in
+ intermediate computations when the parameters have different signs.
+
+2015-01-07 Javier Miranda <miranda@adacore.com>
+
+ * exp_ch3.adb (Build_Init_Procedure): For derived types,
+ improve the code which takes care of identifying and moving to
+ the beginning of the init-proc the call to the init-proc of the
+ parent type.
+
2015-01-07 Olivier Hainque <hainque@adacore.com>
* gcc-interface/trans.c (gnat_to_gnu, <N_Expression_With_Action>):
function Time_Of (SC : Seconds_Count; TS : Time_Span) return Time is
begin
- return Time (SC) + TS;
+ -- We want to return Time (SC) + TS. To avoid spurious overflows in
+ -- the intermediate result Time (SC) we take advantage of the different
+ -- signs in SC and TS (when that is the case).
+
+ -- If signs of SC and TS are different then we avoid converting SC to
+ -- Time (as we do in the else part). The reason for that is that SC
+ -- converted to Time may overflow the range of Time, while the addition
+ -- of SC plus TS does not overflow (because of their different signs).
+ -- The approach is to add and remove the greatest value of time
+ -- (greatest absolute value) to both SC and TS. SC and TS have different
+ -- signs, so we add the positive constant to the negative value, and the
+ -- negative constant to the positive value, to prevent overflows.
+
+ if (SC > 0 and then TS < 0.0)
+ or else (SC < 0 and then TS > 0.0)
+ then
+ declare
+ Closest_Boundary : constant Seconds_Count :=
+ (if TS >= 0.0 then
+ Seconds_Count (Time_Span_Last - Time_Span (0.5))
+ else
+ Seconds_Count (Time_Span_First + Time_Span (0.5)));
+ -- Value representing the integer part of the Time_Span boundary
+ -- closest to TS (its number of seconds). Truncate towards zero
+ -- to be sure that transforming this value back into Time cannot
+ -- overflow (when SC is equal to 0). The sign of Closest_Boundary
+ -- is always different from the sign of SC, hence avoiding
+ -- overflow in the expression Time (SC + Closest_Boundary)
+ -- which is part of the return statement.
+
+ Dist_To_Boundary : constant Time_Span :=
+ TS - Time_Span (Closest_Boundary);
+ -- Distance between TS and Closest_Boundary expressed in Time_Span
+ -- Both operands in the substraction have the same sign, hence
+ -- avoiding overflow.
+
+ begin
+ -- Both operands in the inner addition have different signs,
+ -- hence avoiding overflow. The Time () conversion and the outer
+ -- addition can overflow only if SC + TC is not within Time'Range.
+
+ return Time (SC + Closest_Boundary) + Dist_To_Boundary;
+ end;
+
+ -- Both operands have the same sign, so we can convert SC into Time
+ -- right away; if this conversion overflows then the result of adding SC
+ -- and TS would overflow anyway (so we would just be detecting the
+ -- overflow a bit earlier).
+
+ else
+ return Time (SC) + TS;
+ end if;
end Time_Of;
-----------------
-- such case the initialization of the _parent field was not
-- generated.
- if not Is_Interface (Etype (Rec_Ent))
- and then Nkind (First (Stmts)) = N_Procedure_Call_Statement
- and then Is_Init_Proc (Name (First (Stmts)))
- then
- Prepend_To (Body_Stmts, Remove_Head (Stmts));
+ if not Is_Interface (Etype (Rec_Ent)) then
+ declare
+ Parent_IP : constant Name_Id :=
+ Make_Init_Proc_Name (Etype (Rec_Ent));
+ Stmt : Node_Id := First (Stmts);
+ IP_Call : Node_Id := Empty;
+ IP_Stmts : List_Id;
+
+ begin
+ -- Look for a call to the parent IP at the beginning
+ -- of Stmts associated with the record extension
+
+ while Present (Stmt) loop
+ if Nkind (Stmt) = N_Procedure_Call_Statement
+ and then Chars (Name (Stmt)) = Parent_IP
+ then
+ IP_Call := Stmt;
+ exit;
+ end if;
+
+ Next (Stmt);
+ end loop;
+
+ -- If found then move it to the beginning of the
+ -- statements of this IP routine
+
+ if Present (IP_Call) then
+ IP_Stmts := New_List;
+ loop
+ Stmt := Remove_Head (Stmts);
+ Append_To (IP_Stmts, Stmt);
+ exit when Stmt = IP_Call;
+ end loop;
+
+ Prepend_List_To (Body_Stmts, IP_Stmts);
+ end if;
+ end;
end if;
Append_List_To (Body_Stmts, Stmts);
#define Generate_SCO_Instance_Table opt__generate_sco_instance_table
#define GNAT_Mode opt__gnat_mode
#define List_Representation_Info opt__list_representation_info
+#define No_Strict_Aliasing_CP opt__no_strict_aliasing
typedef enum {Setjmp_Longjmp, Back_End_Exceptions} Exception_Mechanism_Type;
extern Boolean Generate_SCO_Instance_Table;
extern Boolean GNAT_Mode;
extern Int List_Representation_Info;
+extern Boolean No_Strict_Aliasing_CP;
/* restrict: */
/* Initialize the GCC support for FP operations. */
gnat_init_gcc_fp ();
+ /* Force -fno-strict-aliasing if the configuration pragma was seen. */
+ if (No_Strict_Aliasing_CP)
+ flag_strict_aliasing = 0;
+
/* Now translate the compilation unit proper. */
Compilation_Unit_to_gnu (gnat_root);
Limit : ptrdiff_t := ptrdiff_t'Last;
Terminator : Element := Default_Terminator)
is
- S : Pointer := Source;
- T : Pointer := Target;
- L : ptrdiff_t := Limit;
-
+ L : ptrdiff_t;
+ S : Pointer := Source;
begin
- if S = null or else T = null then
+ if Source = null then
raise Dereference_Error;
-
- else
- while L > 0 loop
- T.all := S.all;
- exit when T.all = Terminator;
- Increment (T);
- Increment (S);
- L := L - 1;
- end loop;
end if;
+
+ -- Compute array length (including the terminator)
+ L := 1;
+ while S.all /= Terminator and then L < Limit loop
+ L := L + 1;
+ Increment (S);
+ end loop;
+
+ Copy_Array (Source, Target, L);
end Copy_Terminated_Array;
---------------
Add_RACW_Features (Def_Id);
end if;
- -- Set no strict aliasing flag if config pragma seen
-
- if Opt.No_Strict_Aliasing then
- Set_No_Strict_Aliasing (Base_Type (Def_Id));
- end if;
-
when N_Array_Type_Definition =>
Array_Type_Declaration (T, Def);
-- Check whether the renaming is for a defaulted actual subprogram
-- with a class-wide actual.
- if CW_Actual and then Box_Present (Inst_Node) then
+ -- The class-wide wrapper is not needed when we are in
+ -- GNATprove_Mode and there is an external axiomatization on the
+ -- package.
+
+ if CW_Actual
+ and then Box_Present (Inst_Node)
+ and then not (GNATprove_Mode
+ and then
+ Present (Containing_Package_With_Ext_Axioms
+ (Formal_Spec)))
+ then
Build_Class_Wide_Wrapper (New_S, Old_S);
elsif Is_Entity_Name (Nam)
projects / gcc.git / commitdiff