+2019-08-20 Bob Duff <duff@adacore.com>
+
+ * sem_ch13.adb (Is_Null_Array): New function, used to detect the
+ null array case; used to warn about uncheckedly converting to a
+ zero-sized array. It is unfortunate that we can't just check
+ the size, and warn on all cases of converting from a
+ nonzero-sized type to a zero-sized one. That's because "0" means
+ two different things: "size is zero" and "size is unknown".
+ Until we fix that design flaw, we need this more targeted fix.
+
2019-08-20 Bob Duff <duff@adacore.com>
* libgnat/a-cborma.adb, libgnat/a-cborse.adb (Clear): Repeatedly
------------------------------------
procedure Validate_Unchecked_Conversions is
+ function Is_Null_Array (T : Entity_Id) return Boolean;
+ -- We want to warn in the case of converting to a wrong-sized array of
+ -- bytes, including the zero-size case. This returns True in that case,
+ -- which is necessary because a size of 0 is used to indicate both an
+ -- unknown size and a size of 0. It's OK for this to return True in
+ -- other zero-size cases, but we don't go out of our way; for example,
+ -- we don't bother with multidimensional arrays.
+
+ function Is_Null_Array (T : Entity_Id) return Boolean is
+ begin
+ if Is_Array_Type (T) and then Is_Constrained (T) then
+ declare
+ Index : constant Node_Id := First_Index (T);
+ R : Node_Id; -- N_Range
+ begin
+ case Nkind (Index) is
+ when N_Range =>
+ R := Index;
+ when N_Subtype_Indication =>
+ R := Range_Expression (Constraint (Index));
+ when N_Identifier | N_Expanded_Name =>
+ R := Scalar_Range (Entity (Index));
+ when others =>
+ raise Program_Error;
+ end case;
+
+ return Is_Null_Range (Low_Bound (R), High_Bound (R));
+ end;
+ end if;
+
+ return False;
+ end Is_Null_Array;
+
begin
for N in Unchecked_Conversions.First .. Unchecked_Conversions.Last loop
declare
begin
-- Skip if function marked as warnings off
- if Warnings_Off (Act_Unit) then
+ if Warnings_Off (Act_Unit) or else Serious_Errors_Detected > 0 then
goto Continue;
end if;
- -- This validation check, which warns if we have unequal sizes for
- -- unchecked conversion, and thus potentially implementation
- -- dependent semantics, is one of the few occasions on which we
- -- use the official RM size instead of Esize. See description in
- -- Einfo "Handling of Type'Size Values" for details.
-
- if Serious_Errors_Detected = 0
- and then Known_Static_RM_Size (Source)
- and then Known_Static_RM_Size (Target)
+ -- Don't do the check if warnings off for either type, note the
+ -- deliberate use of OR here instead of OR ELSE to get the flag
+ -- Warnings_Off_Used set for both types if appropriate.
- -- Don't do the check if warnings off for either type, note the
- -- deliberate use of OR here instead of OR ELSE to get the flag
- -- Warnings_Off_Used set for both types if appropriate.
+ if Has_Warnings_Off (Source) or Has_Warnings_Off (Target) then
+ goto Continue;
+ end if;
- and then not (Has_Warnings_Off (Source)
- or
- Has_Warnings_Off (Target))
+ if (Known_Static_RM_Size (Source)
+ and then Known_Static_RM_Size (Target))
+ or else Is_Null_Array (Target)
then
+ -- This validation check, which warns if we have unequal sizes
+ -- for unchecked conversion, and thus implementation dependent
+ -- semantics, is one of the few occasions on which we use the
+ -- official RM size instead of Esize. See description in Einfo
+ -- "Handling of Type'Size Values" for details.
+
Source_Siz := RM_Size (Source);
Target_Siz := RM_Size (Target);
--- /dev/null
+-- { dg-do compile }
+
+with Ada.Unchecked_Conversion;
+with System.Storage_Elements; use System.Storage_Elements;
+
+procedure Unchecked_Convert14 is
+
+ type R is record
+ I : Integer;
+ C : Character;
+ end record;
+
+ subtype Buffer is Storage_Array (1 .. 0);
+
+ function As_Buffer is new Ada.Unchecked_Conversion -- { dg-warning "types for unchecked conversion have different sizes" }
+ (Source => R, Target => Buffer);
+
+ type Buffer_1 is array (Storage_Offset range 1 .. 1) of Storage_Element;
+
+ function As_Buffer_1 is new Ada.Unchecked_Conversion -- { dg-warning "types for unchecked conversion have different sizes" }
+ (Source => R, Target => Buffer_1);
+
+ B : Buffer;
+ B_1 : Buffer_1;
+ My_R : R := (1, 'x');
+
+begin
+ B := As_Buffer (My_R);
+ B_1 := As_Buffer_1 (My_R);
+end Unchecked_Convert14;
projects / gcc.git / commitdiff