gcc/testsuite/gnat.dg/loop_optimization9.adb

   1 -- { dg-do compile }
   2 -- { dg-options "-gnatws -O3" }
   3 -- { dg-options "-gnatws -O3 -msse" { target i?86-*-* x86_64-*-* } }
   4
   5 with System.Soft_Links;
   6
   7 package body Loop_Optimization9 is
   8
   9    package SSL renames System.Soft_Links;
  10
  11    First_Temp_File_Name : constant String := "GNAT-TEMP-000000.TMP";
  12
  13    Current_Temp_File_Name : String := First_Temp_File_Name;
  14
  15    Temp_File_Name_Last_Digit : constant Positive :=
  16                                  First_Temp_File_Name'Last - 4;
  17
  18    function Argument_String_To_List
  19      (Arg_String : String) return Argument_List_Access
  20    is
  21       Max_Args : constant Integer := Arg_String'Length;
  22       New_Argv : Argument_List (1 .. Max_Args);
  23       New_Argc : Natural := 0;
  24       Idx      : Integer;
  25
  26    begin
  27       Idx := Arg_String'First;
  28
  29       loop
  30          exit when Idx > Arg_String'Last;
  31
  32          declare
  33             Quoted  : Boolean := False;
  34             Backqd  : Boolean := False;
  35             Old_Idx : Integer;
  36
  37          begin
  38             Old_Idx := Idx;
  39
  40             loop
  41                --  An unquoted space is the end of an argument
  42
  43                if not (Backqd or Quoted)
  44                  and then Arg_String (Idx) = ' '
  45                then
  46                   exit;
  47
  48                --  Start of a quoted string
  49
  50                elsif not (Backqd or Quoted)
  51                  and then Arg_String (Idx) = '"'
  52                then
  53                   Quoted := True;
  54
  55                --  End of a quoted string and end of an argument
  56
  57                elsif (Quoted and not Backqd)
  58                  and then Arg_String (Idx) = '"'
  59                then
  60                   Idx := Idx + 1;
  61                   exit;
  62
  63                --  Following character is backquoted
  64
  65                elsif Arg_String (Idx) = '\' then
  66                   Backqd := True;
  67
  68                --  Turn off backquoting after advancing one character
  69
  70                elsif Backqd then
  71                   Backqd := False;
  72
  73                end if;
  74
  75                Idx := Idx + 1;
  76                exit when Idx > Arg_String'Last;
  77             end loop;
  78
  79             --  Found an argument
  80
  81             New_Argc := New_Argc + 1;
  82             New_Argv (New_Argc) :=
  83               new String'(Arg_String (Old_Idx .. Idx - 1));
  84          end;
  85       end loop;
  86
  87       return new Argument_List'(New_Argv (1 .. New_Argc));
  88    end Argument_String_To_List;
  89
  90    procedure Create_Temp_File_Internal
  91      (FD        : out File_Descriptor;
  92       Name      : out String_Access)
  93    is
  94       Pos      : Positive;
  95    begin
  96       File_Loop : loop
  97          Locked : begin
  98             Pos := Temp_File_Name_Last_Digit;
  99
 100             Digit_Loop :
 101             loop
 102                case Current_Temp_File_Name (Pos) is
 103                   when '0' .. '8' =>
 104                      Current_Temp_File_Name (Pos) :=
 105                        Character'Succ (Current_Temp_File_Name (Pos));
 106                      exit Digit_Loop;
 107
 108                   when '9' =>
 109                      Current_Temp_File_Name (Pos) := '0';
 110                      Pos := Pos - 1;
 111
 112                   when others =>
 113
 114                      SSL.Unlock_Task.all;
 115                      FD := 0;
 116                      Name := null;
 117                      exit File_Loop;
 118                end case;
 119             end loop Digit_Loop;
 120          end Locked;
 121       end loop File_Loop;
 122    end Create_Temp_File_Internal;
 123
 124 end Loop_Optimization9;