`f8aae86`

Fix fgof-temp file semantics

Authored by

espadonne 3 weeks ago

SHA: f8aae86920dc51a9a51a183aa4e146ec5be43b04
Parents: cc571da
Tree: 7402ad4

3 changed files

Status	File	+	-
M	`runtime/src/io_system.rs`	133	17
M	`src/ir/lower.rs`	63	3
M	`tests/cli_driver.rs`	122	0

runtime/src/io_system.rsmodified

+ }
  impl Unit {
 +    fn is_stream_unformatted(&self) -> bool {
 +        self.form == Form::Unformatted && self.access == Access::Stream
 +    }
++
      fn write_bytes(&mut self, data: &[u8]) -> io::Result<()> {
          match &mut self.stream {
              UnitStream::Stdout => {
  /// Close a unit.
  #[no_mangle]
  pub extern "C" fn afs_close(unit: i32, iostat: *mut i32) {
 +    afs_close_ex(unit, std::ptr::null(), 0, iostat);
 +}
++
 +/// Close a unit with optional STATUS= semantics.
 +#[no_mangle]
 +pub extern "C" fn afs_close_ex(unit: i32, status: *const u8, status_len: i64, iostat: *mut i32) {
 +    let delete_on_close = if status.is_null() || status_len <= 0 {
 +        false
 +    } else {
 +        let raw = unsafe { std::slice::from_raw_parts(status, status_len as usize) };
 +        std::str::from_utf8(raw)
 +            .map(|s| s.trim().eq_ignore_ascii_case("delete"))
 +            .unwrap_or(false)
 +    };
++
      let mut state = io_state().lock().unwrap_or_else(|e| e.into_inner());
      if let Some(mut u) = state.units.remove(&unit) {
          let _ = u.flush();
 -        // File is dropped here, closing the handle.
 -        if !iostat.is_null() {
 -            unsafe {
 -                *iostat = 0;
 +        let filename = u.filename.clone();
 +        drop(u);
++
 +        let mut close_status = 0;
 +        if delete_on_close
 +            && !matches!(filename.as_str(), "stdin" | "stdout" | "stderr")
 +            && !filename.is_empty()
 +        {
 +            if let Err(e) = std::fs::remove_file(&filename) {
 +                close_status = e.raw_os_error().unwrap_or(1);
+             }
+         }
++
 +        if !iostat.is_null() {
 +            unsafe { *iostat = close_status };
 +        } else if close_status != 0 {
 +            eprintln!("CLOSE: {}: {}", filename, io::Error::from_raw_os_error(close_status));
 +            std::process::exit(1);
 +        }
      } else {
          if !iostat.is_null() {
              unsafe {
  pub extern "C" fn afs_write_int(unit: i32, val: i32) {
      let mut state = io_state().lock().unwrap_or_else(|e| e.into_inner());
      if let Some(u) = state.get_unit(unit) {
 -        let _ = u.write_str(&format!(" {}", val));
 +        if u.is_stream_unformatted() {
 +            let _ = u.write_raw(&val.to_ne_bytes());
 +        } else {
 +            let _ = u.write_str(&format!(" {}", val));
 +        }
+     }
+ }
  pub extern "C" fn afs_write_int64(unit: i32, val: i64) {
      let mut state = io_state().lock().unwrap_or_else(|e| e.into_inner());
      if let Some(u) = state.get_unit(unit) {
 -        let _ = u.write_str(&format!(" {}", val));
 +        if u.is_stream_unformatted() {
 +            let _ = u.write_raw(&val.to_ne_bytes());
 +        } else {
 +            let _ = u.write_str(&format!(" {}", val));
 +        }
+     }
+ }
  pub extern "C" fn afs_write_int128(unit: i32, val: i128) {
      let mut state = io_state().lock().unwrap_or_else(|e| e.into_inner());
      if let Some(u) = state.get_unit(unit) {
 -        let _ = u.write_str(&format!(" {}", val));
 +        if u.is_stream_unformatted() {
 +            let _ = u.write_raw(&val.to_ne_bytes());
 +        } else {
 +            let _ = u.write_str(&format!(" {}", val));
 +        }
+     }
+ }
  pub extern "C" fn afs_write_real(unit: i32, val: f32) {
      let mut state = io_state().lock().unwrap_or_else(|e| e.into_inner());
      if let Some(u) = state.get_unit(unit) {
 -        let _ = u.write_str(&format!("  {:14.7E}", val));
 +        if u.is_stream_unformatted() {
 +            let _ = u.write_raw(&val.to_ne_bytes());
 +        } else {
 +            let _ = u.write_str(&format!("  {:14.7E}", val));
 +        }
+     }
+ }
  pub extern "C" fn afs_write_real64(unit: i32, val: f64) {
      let mut state = io_state().lock().unwrap_or_else(|e| e.into_inner());
      if let Some(u) = state.get_unit(unit) {
 -        let _ = u.write_str(&format!("  {:22.15E}", val));
 +        if u.is_stream_unformatted() {
 +            let _ = u.write_raw(&val.to_ne_bytes());
 +        } else {
 +            let _ = u.write_str(&format!("  {:22.15E}", val));
 +        }
+     }
+ }
      let (re, im) = unsafe { (*ptr, *ptr.add(1)) };
      let mut state = io_state().lock().unwrap_or_else(|e| e.into_inner());
      if let Some(u) = state.get_unit(unit) {
 -        let _ = u.write_str(&format!(" ({:14.7E},{:14.7E})", re, im));
 +        if u.is_stream_unformatted() {
 +            let _ = u.write_raw(&re.to_ne_bytes());
 +            let _ = u.write_raw(&im.to_ne_bytes());
 +        } else {
 +            let _ = u.write_str(&format!(" ({:14.7E},{:14.7E})", re, im));
 +        }
+     }
+ }
      let (re, im) = unsafe { (*ptr, *ptr.add(1)) };
      let mut state = io_state().lock().unwrap_or_else(|e| e.into_inner());
      if let Some(u) = state.get_unit(unit) {
 -        let _ = u.write_str(&format!(" ({:22.15E},{:22.15E})", re, im));
 +        if u.is_stream_unformatted() {
 +            let _ = u.write_raw(&re.to_ne_bytes());
 +            let _ = u.write_raw(&im.to_ne_bytes());
 +        } else {
 +            let _ = u.write_str(&format!(" ({:22.15E},{:22.15E})", re, im));
 +        }
+     }
+ }
  pub extern "C" fn afs_write_string(unit: i32, ptr: *const u8, len: i64) {
      let mut state = io_state().lock().unwrap_or_else(|e| e.into_inner());
      if let Some(u) = state.get_unit(unit) {
 -        let _ = u.write_str(" ");
 -        if !ptr.is_null() && len > 0 {
 -            let slice = unsafe { std::slice::from_raw_parts(ptr, len as usize) };
 -            let _ = u.write_bytes(slice);
 +        if u.is_stream_unformatted() {
 +            if !ptr.is_null() && len > 0 {
 +                let slice = unsafe { std::slice::from_raw_parts(ptr, len as usize) };
 +                let _ = u.write_raw(slice);
 +            }
 +        } else {
 +            let _ = u.write_str(" ");
 +            if !ptr.is_null() && len > 0 {
 +                let slice = unsafe { std::slice::from_raw_parts(ptr, len as usize) };
 +                let _ = u.write_bytes(slice);
 +            }
+         }
+     }
+ }
  pub extern "C" fn afs_write_logical(unit: i32, val: i32) {
      let mut state = io_state().lock().unwrap_or_else(|e| e.into_inner());
      if let Some(u) = state.get_unit(unit) {
 -        let _ = u.write_str(if val != 0 { " T" } else { " F" });
 +        if u.is_stream_unformatted() {
 +            let _ = u.write_raw(&val.to_ne_bytes());
 +        } else {
 +            let _ = u.write_str(if val != 0 { " T" } else { " F" });
 +        }
+     }
+ }
  pub extern "C" fn afs_write_newline(unit: i32) {
      let mut state = io_state().lock().unwrap_or_else(|e| e.into_inner());
      if let Some(u) = state.get_unit(unit) {
 +        if u.is_stream_unformatted() {
 +            let _ = u.flush();
 +            return;
 +        }
          let _ = u.write_str("\n");
          let _ = u.flush();
+     }
      match u.next_read_token() {
          Ok(Some(token)) => {
 -            crate::string::afs_assign_char_fixed(dest, dest_len, token.as_ptr(), token.len() as i64);
 +            crate::string::afs_assign_char_fixed(
 +                dest,
 +                dest_len,
 +                token.as_ptr(),
 +                token.len() as i64,
 +            );
              if !iostat.is_null() {
                  unsafe {
                      *iostat = 0;
          afs_write_newline(6);
+     }
 +    #[test]
 +    fn stream_unformatted_string_write_preserves_exact_bytes() {
 +        let path = "/tmp/afs_stream_unformatted_string_write.dat";
 +        let mut iostat = -99i32;
 +        let cb = OpenControlBlock {
 +            unit: 94,
 +            filename: path.as_ptr(),
 +            filename_len: path.len() as i64,
 +            status: "replace".as_ptr(),
 +            status_len: 7,
 +            action: "write".as_ptr(),
 +            action_len: 5,
 +            access: "stream".as_ptr(),
 +            access_len: 6,
 +            form: "unformatted".as_ptr(),
 +            form_len: 11,
 +            recl: 0,
 +            iostat: &mut iostat,
 +            newunit: std::ptr::null_mut(),
 +            position: std::ptr::null(),
 +            position_len: 0,
 +        };
++
 +        afs_open(&cb);
 +        assert_eq!(iostat, 0, "expected stream-unformatted OPEN to succeed");
++
 +        afs_write_string(94, "alpha".as_ptr(), 5);
 +        afs_write_newline(94);
 +        afs_close(94, std::ptr::null_mut());
++
 +        let content = std::fs::read(path).unwrap();
 +        assert_eq!(content, b"alpha", "expected exact stream bytes");
 +    }
++
      #[test]
      fn write_i128_to_file() {
          let path = "/tmp/afs_write_i128_test.dat";

src/ir/lower.rsmodified

+         }
          Stmt::Close { specs } => {
 -            let unit = if let Some(s) = specs.first() {
 +            let unit_spec = specs
 +                .iter()
 +                .find(|s| {
 +                    s.keyword
 +                        .as_deref()
 +                        .map(|k| k.eq_ignore_ascii_case("unit"))
 +                        .unwrap_or(false)
 +                })
 +                .or_else(|| specs.iter().find(|s| s.keyword.is_none()));
 +            let iostat_spec = specs.iter().find(|s| {
 +                s.keyword
 +                    .as_deref()
 +                    .map(|k| k.eq_ignore_ascii_case("iostat"))
 +                    .unwrap_or(false)
 +            });
 +            let status_spec = specs.iter().find(|s| {
 +                s.keyword
 +                    .as_deref()
 +                    .map(|k| k.eq_ignore_ascii_case("status"))
 +                    .unwrap_or(false)
 +            });
 +            let unit = if let Some(s) = unit_spec {
                  lower_expr_ctx(b, ctx, &s.value)
              } else {
                  b.const_i32(6)
              };
              let null = b.const_i64(0);
 +            let unit_i32 = coerce_to_type(b, unit, &IrType::Int(IntWidth::I32));
 +            let iostat_ptr = iostat_spec
 +                .map(|spec| lower_arg_by_ref_ctx(b, ctx, &spec.value))
 +                .unwrap_or(null);
 +            let (status_ptr, status_len) = status_spec
 +                .map(|spec| {
 +                    lower_string_expr_with_layouts(
 +                        b,
 +                        &ctx.locals,
 +                        &spec.value,
 +                        ctx.st,
 +                        Some(ctx.type_layouts),
 +                    )
 +                })
 +                .unwrap_or_else(|| (null, null));
              b.call(
 -                FuncRef::External("afs_close".into()),
 -                vec![unit, null],
 +                FuncRef::External("afs_close_ex".into()),
 +                vec![unit_i32, status_ptr, status_len, iostat_ptr],
                  IrType::Void,
              );
+         }
          let src_field = b.gep(src_ptr, vec![offset], IrType::Int(IntWidth::I8));
          if field.allocatable && is_deferred_char_component_field(field) {
 +            let src_alloc = b.call(
 +                FuncRef::External("afs_string_allocated".into()),
 +                vec![src_field],
 +                IrType::Int(IntWidth::I32),
 +            );
 +            let zero_i32 = b.const_i32(0);
 +            let is_unallocated = b.icmp(CmpOp::Eq, src_alloc, zero_i32);
 +            let unalloc_bb = b.create_block("derived_char_unalloc");
 +            let copy_bb = b.create_block("derived_char_copy");
 +            let join_bb = b.create_block("derived_char_copy_join");
 +            b.cond_branch(is_unallocated, unalloc_bb, vec![], copy_bb, vec![]);
++
 +            b.set_block(unalloc_bb);
 +            b.call(
 +                FuncRef::External("afs_dealloc_string".into()),
 +                vec![dest_field],
 +                IrType::Void,
 +            );
 +            b.branch(join_bb, vec![]);
++
 +            b.set_block(copy_bb);
              let (src_data, src_len) = load_string_descriptor_view(b, src_field);
              b.call(
                  FuncRef::External("afs_assign_char_deferred".into()),
                  vec![dest_field, src_data, src_len],
                  IrType::Void,
              );
 +            b.branch(join_bb, vec![]);
++
 +            b.set_block(join_bb);
              continue;
+         }

tests/cli_driver.rsmodified

      let _ = std::fs::remove_file(&src);
+ }
 +#[test]
 +fn stream_unformatted_char_write_preserves_exact_bytes() {
 +    let output_file = unique_path("stream_unformatted_char_write", "bin");
 +    let src = write_program(
 +        &format!(
 +            "program p\n  implicit none\n  integer :: unit_num, ios\n  open(newunit=unit_num, file='{}', status='replace', action='write', access='stream', form='unformatted', iostat=ios)\n  if (ios /= 0) error stop 1\n  write(unit_num, iostat=ios) 'alpha'\n  if (ios /= 0) error stop 2\n  close(unit_num)\nend program\n",
 +            output_file.display()
 +        ),
 +        "stream_unformatted_char_write.f90",
 +    );
 +    let out = unique_path("stream_unformatted_char_write", "bin");
 +    let compile = Command::new(compiler("armfortas"))
 +        .args([src.to_str().unwrap(), "-o", out.to_str().unwrap()])
 +        .output()
 +        .expect("stream unformatted char write compile failed to spawn");
 +    assert!(
 +        compile.status.success(),
 +        "stream unformatted char write compile failed: {}",
 +        String::from_utf8_lossy(&compile.stderr)
 +    );
++
 +    let run = Command::new(&out)
 +        .output()
 +        .expect("stream unformatted char write run failed");
 +    assert!(
 +        run.status.success(),
 +        "stream unformatted char write run failed: status={:?} stderr={}",
 +        run.status,
 +        String::from_utf8_lossy(&run.stderr)
 +    );
++
 +    let bytes = std::fs::read(&output_file).expect("cannot read stream unformatted char output");
 +    assert_eq!(
 +        bytes,
 +        b"alpha",
 +        "expected exact bytes from stream-unformatted character write, got {:?}",
 +        bytes
 +    );
++
 +    let _ = std::fs::remove_file(&output_file);
 +    let _ = std::fs::remove_file(&out);
 +    let _ = std::fs::remove_file(&src);
 +}
++
  #[test]
  fn repeated_nonadvancing_a1_read_preserves_embedded_nul_bytes() {
      let input = unique_path("nonadvancing_a1_char_read", "bin");
      let _ = std::fs::remove_dir_all(&dir);
+ }
 +#[test]
 +fn close_status_delete_removes_file() {
 +    let path = unique_path("close_status_delete", "txt");
 +    let src = write_program(
 +        &format!(
 +            "program p\n  implicit none\n  integer :: unit, ios\n  open(newunit=unit, file='{}', status='replace', action='write', iostat=ios)\n  if (ios /= 0) error stop 1\n  write(unit, '(a)', iostat=ios) 'hello'\n  if (ios /= 0) error stop 2\n  close(unit, status='delete', iostat=ios)\n  if (ios /= 0) error stop 3\n  print *, 'ok'\nend program\n",
 +            path.display()
 +        ),
 +        "f90",
 +    );
 +    let out = unique_path("close_status_delete", "bin");
 +    let compile = Command::new(compiler("armfortas"))
 +        .args([src.to_str().unwrap(), "-o", out.to_str().unwrap()])
 +        .output()
 +        .expect("close status delete compile failed to spawn");
 +    assert!(
 +        compile.status.success(),
 +        "close status delete compile failed: {}",
 +        String::from_utf8_lossy(&compile.stderr)
 +    );
++
 +    let run = Command::new(&out)
 +        .output()
 +        .expect("close status delete run failed");
 +    assert!(
 +        run.status.success(),
 +        "close status delete run failed: status={:?} stderr={}",
 +        run.status,
 +        String::from_utf8_lossy(&run.stderr)
 +    );
 +    assert!(
 +        !path.exists(),
 +        "close(status='delete') should remove the file: {}",
 +        path.display()
 +    );
++
 +    let _ = std::fs::remove_file(&out);
 +    let _ = std::fs::remove_file(&src);
 +    let _ = std::fs::remove_file(&path);
 +}
++
  #[test]
  fn bind_c_interface_function_returning_c_ptr_runs() {
      let dir = unique_dir("bind_c_c_ptr_return");
      let _ = std::fs::remove_file(&src);
+ }
 +#[test]
 +fn derived_function_result_keeps_unallocated_allocatable_char_components_unallocated() {
 +    let src = write_program(
 +        "module m\n  implicit none\n  type :: options_t\n    logical :: cleanup_on_close = .true.\n    character(len=:), allocatable :: prefix\n    character(len=:), allocatable :: suffix\n    character(len=:), allocatable :: parent_dir\n  end type options_t\ncontains\n  function clear_options() result(options)\n    type(options_t) :: options\n    options%cleanup_on_close = .true.\n  end function\nend module\n\nprogram p\n  use m\n  implicit none\n  type(options_t) :: options\n  options = clear_options()\n  if (.not. options%cleanup_on_close) error stop 1\n  if (allocated(options%prefix)) error stop 2\n  if (allocated(options%suffix)) error stop 3\n  if (allocated(options%parent_dir)) error stop 4\n  print *, 'ok'\nend program\n",
 +        "f90",
 +    );
 +    let out = unique_path("derived_result_unalloc_char_components", "bin");
 +    let compile = Command::new(compiler("armfortas"))
 +        .args([src.to_str().unwrap(), "-o", out.to_str().unwrap()])
 +        .output()
 +        .expect("derived result unalloc char component compile failed to spawn");
 +    assert!(
 +        compile.status.success(),
 +        "derived result unalloc char component compile failed: {}",
 +        String::from_utf8_lossy(&compile.stderr)
 +    );
++
 +    let run = Command::new(&out)
 +        .output()
 +        .expect("derived result unalloc char component run failed");
 +    assert!(
 +        run.status.success(),
 +        "derived result unalloc char component run failed: status={:?} stderr={}",
 +        run.status,
 +        String::from_utf8_lossy(&run.stderr)
 +    );
 +    let stdout = String::from_utf8_lossy(&run.stdout);
 +    assert!(
 +        stdout.contains("ok"),
 +        "unexpected derived result unalloc char component output: {}",
 +        stdout
 +    );
++
 +    let _ = std::fs::remove_file(&out);
 +    let _ = std::fs::remove_file(&src);
 +}
++
  #[test]
  fn derived_array_growth_keeps_unallocated_allocatable_components_clear() {
      let src = write_program(